diff --git a/cave/build/static/linux/cave/awips2VisualizeUtility.sh b/cave/build/static/linux/cave/awips2VisualizeUtility.sh index 5f6ab56892..30e4eecea1 100644 --- a/cave/build/static/linux/cave/awips2VisualizeUtility.sh +++ b/cave/build/static/linux/cave/awips2VisualizeUtility.sh @@ -34,47 +34,47 @@ # This script will kill any running AlertViz and/or Cave # processes when a user logs off. -if [ ! -f ${HOME}/vizUtility.log ]; then - touch ${HOME}/vizUtility.log +if [ ! -f /tmp/vizUtility.log ]; then + touch /tmp/vizUtility.log else - echo "" >> ${HOME}/vizUtility.log + echo "" > /tmp/vizUtility.log fi -date >> ${HOME}/vizUtility.log +date >> /tmp/vizUtility.log function findAlertvizProcesses { # Find all the alertviz processes. -echo "Searching for alertviz processes." >> ${HOME}/vizUtility.log +echo "Searching for alertviz processes." >> /tmp/vizUtility.log zpid=` ps u -u $USER | grep '[a]lertviz' | awk '{print $2}' ` npid=` echo $zpid | wc -w ` if [ $npid -le 0 ] then - echo "There are no alertviz processes found." >> ${HOME}/vizUtility.log - date >> ${HOME}/vizUtility.log + echo "There are no alertviz processes found." >> /tmp/vizUtility.log + date >> /tmp/vizUtility.log fi } function findAlertvizShProcesses { # Find all the alertviz.sh processes. -echo "Searching for alertviz.sh processes." >> ${HOME}/vizUtility.log +echo "Searching for alertviz.sh processes." >> /tmp/vizUtility.log zpid=` ps u -u $USER | grep '[a]lertviz.sh' | awk '{print $2}' ` npid=` echo $zpid | wc -w ` if [ $npid -le 0 ] then - echo "There are no alertviz.sh processes found." >> ${HOME}/vizUtility.log - date >> ${HOME}/vizUtility.log + echo "There are no alertviz.sh processes found." >> /tmp/vizUtility.log + date >> /tmp/vizUtility.log fi } function findCaveProcesses { # Find all the Cave processes. -echo "Searching for cave processes." >> ${HOME}/vizUtility.log +echo "Searching for cave processes." >> /tmp/vizUtility.log zpid=` ps u -u $USER | grep '[c]ave' | awk '{print $2}' ` npid=` echo $zpid | wc -w ` if [ $npid -le 0 ] then - echo "There are no cave processes found." >> ${HOME}/vizUtility.log - date >> ${HOME}/vizUtility.log + echo "There are no cave processes found." >> /tmp/vizUtility.log + date >> /tmp/vizUtility.log fi } @@ -83,22 +83,22 @@ fi findAlertvizShProcesses for pid in $zpid do - echo "Attempting to kill 'alertviz.sh' process with pid ${pid}." >> ${HOME}/vizUtility.log - kill ${pid} 2>> ${HOME}/vizUtility.log + echo "Attempting to kill 'alertviz.sh' process with pid ${pid}." >> /tmp/vizUtility.log + kill ${pid} 2>> /tmp/vizUtility.log done findAlertvizProcesses for pid in $zpid do - echo "Attempting to kill 'alertviz' process with pid ${pid}." >> ${HOME}/vizUtility.log - kill ${pid} 2>> ${HOME}/vizUtility.log + echo "Attempting to kill 'alertviz' process with pid ${pid}." >> /tmp/vizUtility.log + kill ${pid} 2>> /tmp/vizUtility.log done findCaveProcesses for pid in $zpid do - echo "Attempting to kill 'cave' process with pid ${pid}." >> ${HOME}/vizUtility.log - kill ${pid} 2>> ${HOME}/vizUtility.log + echo "Attempting to kill 'cave' process with pid ${pid}." >> /tmp/vizUtility.log + kill ${pid} 2>> /tmp/vizUtility.log done @@ -112,14 +112,14 @@ while [[ $npid -ne 0 && $ntoomany -ne 0 ]] do for pid in $zpid do - echo "Attempting to kill 'alertviz.sh' process with pid ${pid}." >> ${HOME}/vizUtility.log - kill -9 ${pid} 2>> ${HOME}/vizUtility.log + echo "Attempting to kill 'alertviz.sh' process with pid ${pid}." >> /tmp/vizUtility.log + kill -9 ${pid} 2>> /tmp/vizUtility.log done npid=0 ((ntoomany-=1)) if [ $ntoomany -le 1 ] then - echo "The kill alertviz portion of this script $0 has been unable preform its duties. 02" >> ${HOME}/vizUtility.log + echo "The kill alertviz portion of this script $0 has been unable preform its duties. 02" >> /tmp/vizUtility.log break fi sleep 1 @@ -131,20 +131,20 @@ sleep 1 findAlertvizProcesses for pid in $zpid do - echo "Attempting to kill 'alertviz' process with pid ${pid}." >> ${HOME}/vizUtility.log - kill -9 ${pid} 2>> ${HOME}/vizUtility.log + echo "Attempting to kill 'alertviz' process with pid ${pid}." >> /tmp/vizUtility.log + kill -9 ${pid} 2>> /tmp/vizUtility.log done findCaveProcesses for pid in $zpid do - echo "Attempting to kill 'cave' process with pid ${pid}." >> ${HOME}/vizUtility.log - kill -9 ${pid} 2>> ${HOME}/vizUtility.log + echo "Attempting to kill 'cave' process with pid ${pid}." >> /tmp/vizUtility.log + kill -9 ${pid} 2>> /tmp/vizUtility.log done -date >> ${HOME}/vizUtility.log -echo >> ${HOME}/vizUtility.log +date >> /tmp/vizUtility.log +echo >> /tmp/vizUtility.log diff --git a/cots/org.jep.linux32/libjep.so b/cots/org.jep.linux32/libjep.so old mode 100644 new mode 100755 index fd81c35366..1f0f438979 Binary files a/cots/org.jep.linux32/libjep.so and b/cots/org.jep.linux32/libjep.so differ diff --git a/cots/org.jep.linux64/libjep.so b/cots/org.jep.linux64/libjep.so old mode 100644 new mode 100755 index d09ea2db87..2727ad7b76 Binary files a/cots/org.jep.linux64/libjep.so and b/cots/org.jep.linux64/libjep.so differ diff --git a/nativeLib/build.native/tools/compile.sh b/nativeLib/build.native/tools/compile.sh old mode 100644 new mode 100755 diff --git a/nativeLib/edex_com/.cproject b/nativeLib/edex_com/.cproject index c5cebfd85f..399a52d2b9 100644 --- a/nativeLib/edex_com/.cproject +++ b/nativeLib/edex_com/.cproject @@ -1,7 +1,5 @@ - - - + @@ -20,12 +18,12 @@ - + @@ -117,12 +115,12 @@ - + diff --git a/nativeLib/edex_notify/.cproject b/nativeLib/edex_notify/.cproject index a0a2fc7b03..b62dd8dd2b 100644 --- a/nativeLib/edex_notify/.cproject +++ b/nativeLib/edex_notify/.cproject @@ -1,7 +1,5 @@ - - - + @@ -21,12 +19,12 @@ - + @@ -105,12 +103,12 @@ - + diff --git a/nativeLib/files.native/awipsShare/hydroapps/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id b/nativeLib/files.native/awipsShare/hydroapps/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id index 9e29681c5a..89fa1c91b1 100644 --- a/nativeLib/files.native/awipsShare/hydroapps/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id +++ b/nativeLib/files.native/awipsShare/hydroapps/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id @@ -1 +1 @@ -a86124ed46f7a16af33a87ae5ba9a1c02b870c80 \ No newline at end of file +8fe0a749af6fc67549da23d33fd3d63a094c1466 \ No newline at end of file diff --git a/nativeLib/files.native/edex/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id b/nativeLib/files.native/edex/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id index 9e29681c5a..89fa1c91b1 100644 --- a/nativeLib/files.native/edex/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id +++ b/nativeLib/files.native/edex/lib/native/linux32/library.ohd.pproc.so.REMOVED.git-id @@ -1 +1 @@ -a86124ed46f7a16af33a87ae5ba9a1c02b870c80 \ No newline at end of file +8fe0a749af6fc67549da23d33fd3d63a094c1466 \ No newline at end of file diff --git a/nativeLib/ncep_grib2module/.cproject b/nativeLib/ncep_grib2module/.cproject index 3459feebf0..65a0942f1e 100644 --- a/nativeLib/ncep_grib2module/.cproject +++ b/nativeLib/ncep_grib2module/.cproject @@ -1,7 +1,5 @@ - - - + @@ -16,12 +14,12 @@ - + @@ -53,7 +51,6 @@ - + @@ -149,6 +146,7 @@ @@ -163,13 +161,13 @@ diff --git a/nativeLib/ncep_grib2module/.cproject.BACKUP.30635.cproject b/nativeLib/ncep_grib2module/.cproject.BACKUP.30635.cproject new file mode 100644 index 0000000000..166168ac1a --- /dev/null +++ b/nativeLib/ncep_grib2module/.cproject.BACKUP.30635.cproject @@ -0,0 +1,904 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<<<<<<< HEAD + + + +======= +>>>>>>> master_14.1.1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<<<<<<< HEAD + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +======= +>>>>>>> master_14.1.1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<<<<<<< HEAD +======= + +>>>>>>> master_14.1.1 + diff --git a/nativeLib/ncep_grib2module/.cproject.BASE.30635.cproject b/nativeLib/ncep_grib2module/.cproject.BASE.30635.cproject new file mode 100644 index 0000000000..edcdb86632 --- /dev/null +++ b/nativeLib/ncep_grib2module/.cproject.BASE.30635.cproject @@ -0,0 +1,1225 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/ncep_grib2module/.cproject.LOCAL.30635.cproject b/nativeLib/ncep_grib2module/.cproject.LOCAL.30635.cproject new file mode 100644 index 0000000000..be76fd5e52 --- /dev/null +++ b/nativeLib/ncep_grib2module/.cproject.LOCAL.30635.cproject @@ -0,0 +1,894 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/ncep_grib2module/.cproject.REMOTE.30635.cproject b/nativeLib/ncep_grib2module/.cproject.REMOTE.30635.cproject new file mode 100644 index 0000000000..3459feebf0 --- /dev/null +++ b/nativeLib/ncep_grib2module/.cproject.REMOTE.30635.cproject @@ -0,0 +1,728 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/ncep_grib2module/.gitignore b/nativeLib/ncep_grib2module/.gitignore index 2d69fdad40..3da133aacc 100644 --- a/nativeLib/ncep_grib2module/.gitignore +++ b/nativeLib/ncep_grib2module/.gitignore @@ -1 +1,2 @@ /Build x86 +/Build x86_64 diff --git a/nativeLib/ncep_grib2module/.project b/nativeLib/ncep_grib2module/.project index cb148c3400..8dec5e11c6 100644 --- a/nativeLib/ncep_grib2module/.project +++ b/nativeLib/ncep_grib2module/.project @@ -3,7 +3,7 @@ ncep_grib2module - rary.cots.jasper + rary.cots.g2clib diff --git a/nativeLib/ncep_grib2module/dependencies/lib/g2clib1.1.8.so b/nativeLib/ncep_grib2module/dependencies/lib/g2clib1.1.8.so deleted file mode 100755 index ae014794f7..0000000000 Binary files a/nativeLib/ncep_grib2module/dependencies/lib/g2clib1.1.8.so and /dev/null differ diff --git a/nativeLib/ncep_grib2module/dependencies/lib/libg2.a b/nativeLib/ncep_grib2module/dependencies/lib/libg2.a deleted file mode 100644 index 918e105a28..0000000000 Binary files a/nativeLib/ncep_grib2module/dependencies/lib/libg2.a and /dev/null differ diff --git a/nativeLib/ncep_grib2module/dependencies/lib/libg2wrapper.so b/nativeLib/ncep_grib2module/dependencies/lib/libg2wrapper.so deleted file mode 100755 index 373a10321d..0000000000 Binary files a/nativeLib/ncep_grib2module/dependencies/lib/libg2wrapper.so and /dev/null differ diff --git a/nativeLib/ncep_grib2module/dependencies/lib/libw3.a b/nativeLib/ncep_grib2module/dependencies/lib/libw3.a deleted file mode 100644 index 79b9b4145d..0000000000 Binary files a/nativeLib/ncep_grib2module/dependencies/lib/libw3.a and /dev/null differ diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/CHANGES b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/CHANGES deleted file mode 100755 index a92e71f401..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/CHANGES +++ /dev/null @@ -1,75 +0,0 @@ - -cnvgrib-1.0 - August 2003 - Original version - -cnvgrib-1.0.1 - October 2003 - Corrected error converting level info for - "depth below land surface" from GRIB1 to GRIB2. - - Removed statement that set GRIB1 local table - version to "2". - -cnvgrib-1.0.2 - May 2004 - Changed Master Table Version Number from 1 to the - current "operational" value of 2, when converting - from GRIB1 to GRIB2. - - Added support for Gaussian grids. - - Few minor bug fixes relating to: - 1) ensemble params 191 and 192 (grib1 table ver 2) - 2) negative pv surface values - 3) radius of earth - 4) # of missing values in PDS/PDT - -cnvgrib-1.1.0 - January 2005 - WMO approved the JPEG2000 and PNG Data - Representation Templates ( 5.40000 and 5.40010, - respectively ) for operational use. The - templates were assigned WMO values of 5.40 and - 5.41, respectively. Changes were made to the - source and to acceptable program options to - recognize either template number. - - Added new option "-m" to support encoding of - "Missing" data values within the data field when - using Data Representation Templates 5.2 - (option -p2) and 5.3 (options -p31 and -p32 ). - Missing value management is an alternative to - encoding a bitmap when using DRTs 5.2 and 5.3. - - Fixed bug passing null pointers to routines - expecting a valid target. Thanks to Jaakko - Hyvatti and Portland Group. - - Added fix for bug that caused seg faults on some - systems when generating GRIB1 messages. Thanks - to Robert Shectman for this one. - -cnvgrib-1.1.1 - April 2005 - Corrected the scaling factor used when converting - potential vorticity surface values. - -cnvgrib-1.1.2 - January 2006 - - Added a new option "-nv" to cause vector quantities - to be stored in individual GRIB messages versus - being bundled together which is the default. - -cnvgrib-1.1.4 - May 2007 - - Added a new Grid Definition Template number 204 - - Corrected the sale factor for probabilities - - Added more parameters - - Added the Time Range indicator 51 - -cnvgrib-1.1.5 - Dec 2007 - - Added new local parameters conversion entries - - Declared the variable rmin,rmax in routine (jpcpack.f - and pngpack.f) with double precision to fix for bug - that caused seg fault on NAM tile files - - Added a check for the length of KPDS to determine - the grib is ensemble. - - Added new level (Nominal top of the Atmosphere -cnvgrib-1.1.6 - Jan 2008 - - Added new local parameters conversion entries - - Added new grid id 195 and 196 - - Fixed the V-GRD By setting the LPDS(22)=-1 -cnvgrib-1.1.7 - May 2008 - - Add missing management value option 0 : No explicit - missing values included within data values - Note: Valid only with complex packing: - 1. Complex packing - 2. Complex packing and spatial differencing -cnvgrib-1.1.8 - Aug 2008 - - Added new local parameters conversion entries - and table 131 - - Added a new Grid Definition Template number - 3.32768 (Added Rotate Lat/Lon E-grid) diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/README b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/README deleted file mode 100755 index 94ef607a10..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/README +++ /dev/null @@ -1,56 +0,0 @@ - Mar 24, 2008 - W/NP11:SAG - -cnvgrib utility. - -This command line utility program converts every GRIB -message in the input file from one GRIB edition to another. -It currently converts GRIB1 to GRIB2, and GRIB2 to GRIB1 -using WMO master tables as well as various NCEP local tables. - -The cnvgrib utility requires both the w3lib and g2lib -libraries. - -We have added support for PNG and JPEG2000 image compression -algorithms within the GRIB2 standard. If you would like -this converter to be able to utilize these new GRIB2 Templates, -then the g2lib must be compiled with this support enabled. -The README file included with the "g2lib" library -describes how to compile that library to support PNG and -JPEG2000, and it also lists the external libraries that -are required. These libraries, if desired, will have to linked -in when creating the cnvgrib executable. - - - -Usage: cnvgrib [-h] {-g12|-g21|-g22} [-m|-m0] [-nv] - [{-p0|-p2|-p31|-p32|-p40|-p41}] ingribfile outgribfile - - -Usage: cnvgrib -h For helps and shows all options - - -cnvgrib: version cnvgrib-1.1.7 - -Must use one of the following options: - -g12 converts GRIB1 to GRIB2 - -g21 converts GRIB2 to GRIB1 - -g22 converts GRIB2 to GRIB2 (used to change packing option) - -Optional packing options: (for use with -g12 and -g22 only) - -p0 simple packing - -p2 complex packing - -p31 complex pack with 1st order diffs - -p32 complex pack with 2nd order diffs - -p40 JPEG2000 encoding - -p41 PNG encoding - -Other Optional options: - -nv Do not combine U, V wind components - - Use missing value management instead of bitmap - (ONLY valid with Complex Packing options: -p2, -p31 or -p32 ) - - -m Primary missing values included within the data values - -m0 No explicit missing values included within the data values - diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv12.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv12.f deleted file mode 100755 index 470634f495..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv12.f +++ /dev/null @@ -1,377 +0,0 @@ - subroutine cnv12(ifl1,ifl2,ipack,usemiss,imiss,uvvect) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: cnv12 -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-11 -C -C ABSTRACT: This subroutine converts every GRIB1 field in a file -C to a GRIB2 field. U and V wind component fields are combined -C into a single GRIB2 message. -C -C PROGRAM HISTORY LOG: -C 2003-06-11 Gilbert -C 2003-05-19 Gilbert - Changed Master Table Version Number from 1 to 2. -C - Added check for grib1 table version with params 191 -C and 192 for ensemble probs. -C 2007-03-26 Gordon - Added check for ECMWF data to reference ECMWF -C Conversion tables. -C 2007-10-11 Vuong - Added check for ensemble probs if the kpds > 28 -C 2008-01-28 Vuong - Fixed the V-GRD BY SETTING THE LPDS(22)=-1 and -C increase the array size MAXPTS -C 2008-05-14 Vuong - Add option -m0 No explicit missing values included -C within data values -C -C USAGE: CALL cnv12(ifl1,ifl2,ipack) -C INPUT ARGUMENT LIST: -C ifl1 - Fortran unit number of input GRIB1 file -C ifl2 - Fortran unit number of output GRIB2 file -C ipack - GRIB2 packing option: -C 0 = simple packing -C 2 = group packing -C 31 = group pack with 1st order differencing -C 32 = group pack with 2nd order differencing -C 40 = JPEG2000 encoding -C 40000 = JPEG2000 encoding (obsolete) -C 41 = PNG encoding -C 40010 = PNG encoding (obsolete) -C if ipack .ne. one of the values above, 31 is used as a default. -C usemiss - uses missing value management (instead of bitmaps), for use -C ipack options 2, 31, and 32. -C imiss - Missing value management: -C 0 = No explicit missing values included within data values -C 1 = Primary missing values included within data values -C uvvect - .true. = combine U and V wind components into one GRIB2 msg. -C .flase. = does not combine U and V wind components -C -C INPUT FILES: See ifl1 -C -C OUTPUT FILES: See ifl2 -C -C REMARKS: None -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use params - use params_ecmwf - 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) - 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) - integer :: ipdstmplv(200) - integer :: idrstmpl(200),idrstmplv(200) - integer :: currlen=0 - integer,parameter :: mingrib=500 - logical :: ensemble,ecmwf - Logical*1,allocatable,dimension(:) :: bmp,bmpv -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - ICND=0 - IFLI1=0 - allocate(fld(maxpts)) - allocate(coordlist(maxpts)) - allocate(bmp(maxpts)) -! - iseek=0 - currlen=0 - do - 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 - if (allocated(cgrib)) deallocate(cgrib) - 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 - cycle - endif - else - print *,' cnvgrib: IO Error on input GRIB file.' - stop - 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. - 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 - endif - 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, - & jdum) ! set discipline - else - if (ensemble.and.(kpds(5).eq.191.or.kpds(5).eq.192)) 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, - & 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 - cycle - endif -! -!----------------------------------------------------------------------- -! convert grid info - 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 - 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) - else - call pds2pdt(kpds,ipdsnum,ipdstmpl,numcoord,coordlist,ierr) - endif - 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 - ! - ! 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 ( rmiss .lt. -9999.0 ) then - rmiss=rmiss*10.0 - else - rmiss=-9999.0 - endif - do i=1,numpts - if ( .NOT. bmp(i) ) then - fld(i)=rmiss - bmp(i)=.true. - endif - enddo - idrstmpl(7)=imiss ! Missing value management - call mkieee(rmiss,idrstmpl(8),1) - endif - else - 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 - else - 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) -c 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 (.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 - exit - endif - ipdstmplv=ipdstmpl - if (ecmwf) then ! treat ecmwf data conversion seperately -c print *,' param_ecmwf call 2' - call param_ecmwf_g1_to_g2(kpds(5),kpds(19),idum, - & ipdstmplv(1),ipdstmplv(2)) -c print *,' done with call 2' - else - 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)) - if ( ANY(bmp(1:igds(2)) .NEQV. bmpv(1:igds(2))) ) then - !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 ( rmiss .lt. -9999.0 ) then - rmiss=rmiss*10.0 - else - rmiss=-9999.0 - endif - do i=1,numpts - if ( .NOT. bmpv(i) ) then - fldv(i)=rmiss - bmpv(i)=.true. - endif - enddo - idrstmplv(7)=imiss ! Missing values management - call mkieee(rmiss,idrstmplv(8),1) - endif - else - !print *,'SAGT: BITMAP SAME' - ibmap=254 - endif - else - 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 - else - 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 - 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 - cycle - endif -! print *,' writing ',lengrib,' bytes...' - call wryte(ifl2,lengrib,cgrib) - - enddo - - if (allocated(cgribin)) deallocate(cgribin) - if (allocated(cgrib)) deallocate(cgrib) - if (allocated(fld)) deallocate(fld) - if (allocated(fldv)) deallocate(fldv) - if (allocated(coordlist)) deallocate(coordlist) - if (allocated(bmp)) deallocate(bmp) - if (allocated(bmpv)) deallocate(bmpv) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv21.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv21.f deleted file mode 100755 index 788bbb2236..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv21.f +++ /dev/null @@ -1,206 +0,0 @@ - subroutine cnv21(ifl1,ifl2) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: cnv21 -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-11 -C -C ABSTRACT: This subroutine converts every GRIB2 field in a file -C to a GRIB1 field. If a GRIB2 message contains more than one -C data field, then each field is saved in individual GRIB1 -C messages. -C -C PROGRAM HISTORY LOG: -C 2003-06-11 Gilbert -C 2008-05-14 Vuong - Add option -m0 No explicit missing values included -C within data values -C -C USAGE: CALL cnv21(ifl1,ifl2) -C INPUT ARGUMENT LIST: -C ifl1 - Fortran unit number of input GRIB2 file -C ifl2 - Fortran unit number of output GRIB1 file -C -C INPUT FILES: See ifl1 -C -C OUTPUT FILES: See ifl2 -C -C REMARKS: None -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use grib_mod - use params - integer,intent(in) :: ifl1,ifl2 - - CHARACTER(len=1),allocatable,dimension(:) :: cgrib - CHARACTER(len=8) :: ctemp - type(gribfield) :: gfld - integer,dimension(200) :: jids,jpdt,jgdt - integer :: kpds(200),kgds(200),kens(200),kprob(2) - integer :: kclust(16),kmembr(80) - integer :: currlen=0 - integer :: igds(5)=(/0,0,0,0,0/) - real :: xprob(2) - logical*1,target,dimension(1) :: dummy - logical :: unpack=.true. -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - IFLI1=0 - jdisc=-1 - jids=-9999 - jpdt=-9999 - jgdt=-9999 - jpdtn=-1 - jgdtn=-1 -! - icount=0 - jskp=0 - do - call getgb2(ifl1,ifli1,jskp,jdisc,jids,jpdtn,jpdt,jgdtn,jgdt, - & unpack,jskp,gfld,iret) - if ( iret.ne.0) then - if ( iret.eq.99 ) exit - print *,' getgb2 error = ',iret - cycle - !call errexit(17) - endif - icount=icount+1 - ! - ! Ensure that cgrib array is large enough - ! - newlen=4*gfld%ngrdpts - if ( newlen.gt.currlen ) then - if (allocated(cgrib)) deallocate(cgrib) - allocate(cgrib(newlen),stat=is) - currlen=newlen - endif - ! - ! Construct GDS - ! - igds(1)=gfld%griddef - igds(2)=gfld%ngrdpts - igds(3)=gfld%numoct_opt - igds(4)=gfld%interp_opt - igds(5)=gfld%igdtnum - if ( .NOT. associated(gfld%list_opt) ) - & allocate(gfld%list_opt(1)) - call gdt2gds(igds,gfld%igdtmpl,gfld%num_opt,gfld%list_opt, - & kgds,igrid,iret) - if (iret.ne.0) then - print *,'cnv21: could not create gds' - cycle - endif - !print *,' SAGT: NCEP GRID: ',igrid - ! - ! Construct PDS - ! - call makepds(gfld%discipline,gfld%idsect,gfld%ipdtnum, - & gfld%ipdtmpl,gfld%ibmap,gfld%idrtnum, - & gfld%idrtmpl,kpds,iret) - if (iret.ne.0) then - print *,'cnv21: could not create pds' - cycle - endif - kpds(3)=igrid -C -C Check for Coastal Ocean circulation and UKMET grib grid id. -C ON 388 defined grid id 238 same as grid 244 -C If the process model is 45, and UK Met(74), the grid id is 2 or 45 -C If the process model is 121, the grid id is 238 -C If the process model is 123, the grid id is 244 -C - if (kpds(1).eq.7.AND.kpds(2).eq.121) kpds(3)=238 - if (kpds(1).eq.7.AND.kpds(2).eq.123) kpds(3)=244 - if (kpds(1).eq.74) then - if (kpds(2).eq.45.AND.kpds(3).eq.2) kpds(3)=2 - if (kpds(2).eq.15.AND.kpds(3).eq.45) kpds(3)=45 - if (kpds(2).eq.45.AND.kpds(3).eq.45) kpds(3)=45 - end if - ! - ! Construct Ensemble info, if necessary - ! - if ( (gfld%ipdtnum.ge.1.AND.gfld%ipdtnum.le.6).OR. - & (gfld%ipdtnum.ge.9.AND.gfld%ipdtnum.le.14) ) then - call makepdsens(gfld%ipdtnum,gfld%ipdtmpl,kpds,kens,kprob, - & xprob,kclust,kmembr,iret) - endif - ! - ! If not using bit-map, must assign dummy bit-map - ! - if (gfld%ibmap.ne.0 .AND. gfld%ibmap.ne.254) then - !gfld%bmap => dummy - if ( (gfld%idrtnum.eq.2 .OR. gfld%idrtnum.eq.3) .AND. - & gfld%idrtmpl(7).ne.0 ) then ! convert missings to bitmap - allocate(gfld%bmap(gfld%ngrdpts)) - kpds(4)=ior(kpds(4),64) - if ( gfld%idrtmpl(7).eq.1 ) then - call rdieee(gfld%idrtmpl(8),rmiss1,1) - do i=1,gfld%ngrdpts - if ( gfld%fld(i) .eq. rmiss1 ) then - gfld%bmap(i)=.false. - else - gfld%bmap(i)=.true. - endif - enddo - endif - if ( gfld%idrtmpl(7).eq.2 ) then - call rdieee(gfld%idrtmpl(8),rmiss1,1) - call rdieee(gfld%idrtmpl(9),rmiss2,1) - do i=1,gfld%ngrdpts - if ( gfld%fld(i).eq.rmiss1 .OR. - & gfld%fld(i).eq.rmiss2) then - gfld%bmap(i)=.false. - else - gfld%bmap(i)=.true. - endif - enddo - endif - endif - if ( (gfld%idrtnum.eq.2 .OR. gfld%idrtnum.eq.3) .AND. - & gfld%idrtmpl(7).eq.0 ) then ! convert missings to bitmap - allocate(gfld%bmap(gfld%ngrdpts)) - kpds(4)=ior(kpds(4),64) - call rdieee(gfld%idrtmpl(8),rmiss1,1) - if ( rmiss1 .lt. -9999.0 ) then - rmiss1=rmiss1*10.0 - else - rmiss1=-9999.0 - endif - do i=1,gfld%ngrdpts - if ( gfld%fld(i) .eq. rmiss1 ) then - gfld%bmap(i)=.false. - else - gfld%bmap(i)=.true. - endif - enddo - endif - endif - ! - ! Pack and write GRIB 1 field - ! - ibs=gfld%idrtmpl(2) - !print *,'SAGT:before putgbexn' - if ( .NOT. associated(gfld%bmap) ) allocate(gfld%bmap(1)) - imug=0 - call putgbexn(ifl2,gfld%ngrdpts,kpds,kgds,kens,kprob, - & xprob,kclust,kmembr,ibs,imug,gfld%bmap, - & gfld%fld,iret) - !print *,'SAGT:after putgbexn' - if ( iret.ne.0) then - print *,' putgbexn error = ',iret - cycle - !call errexit(17) - endif - - call gf_free(gfld) - - enddo - - if (allocated(cgrib)) deallocate(cgrib) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv22.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv22.f deleted file mode 100755 index b88c0e5870..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnv22.f +++ /dev/null @@ -1,290 +0,0 @@ - subroutine cnv22(ifl1,ifl2,ipack,usemiss,imiss) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: cnv22 -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-11 -C -C ABSTRACT: This subroutine converts every GRIB2 field in a file -C to another GRIB2 field, most likely one using a different -C packing option. -C -C PROGRAM HISTORY LOG: -C 2003-06-11 Gilbert -C 2008-05-14 Vuong - Add missing value management option 0 -C -C USAGE: CALL cnv22(ifl1,ifl2,ipack,usemiss,imiss) -C INPUT ARGUMENT LIST: -C ifl1 - Fortran unit number of input GRIB2 file -C ifl2 - Fortran unit number of output GRIB2 file -C ipack - GRIB2 packing option: -C 0 = simple packing -C 2 = group packing -C 31 = group pack with 1st order differencing -C 32 = group pack with 2nd order differencing -C 40 = JPEG2000 encoding -C 40000 = JPEG2000 encoding (obsolete) -C 41 = PNG encoding -C 40010 = PNG encoding (obsolete) -C if ipack .ne. one of the values above, 31 is used as a default. -C usemiss - uses missing value management (instead of bitmaps), for use -C ipack options 2, 31, and 32. -C imiss - Missing value management: -C 0 = No explicit missing values included within data values -C 1 = Primary missing values included within data values -C -C INPUT FILES: See ifl1 -C -C OUTPUT FILES: See ifl2 -C -C REMARKS: None -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use grib_mod - use params - use re_alloc - - integer,intent(in) :: ifl1,ifl2,ipack - logical,intent(in) :: usemiss - - CHARACTER(len=1),pointer,dimension(:) :: cgrib - CHARACTER(len=8) :: ctemp - type(gribfield) :: gfld,prevfld - integer,dimension(200) :: jids,jpdt,jgdt - integer :: listsec0(2)=(/0,2/) - integer :: igds(5)=(/0,0,0,0,0/),previgds(5) - integer :: idrstmpl(200) - integer :: currlen=1000000 - logical :: unpack=.true. - logical :: open_grb=.false. - logical*1,target,dimension(1) :: dummy -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - allocate(cgrib(currlen)) - IFLI1=0 - jdisc=-1 - jids=-9999 - jpdt=-9999 - jgdt=-9999 - jpdtn=-1 - jgdtn=-1 -! - npoints=0 - icount=0 - jskp=0 - do - prevfld=gfld - call getgb2(ifl1,ifli1,jskp,jdisc,jids,jpdtn,jpdt,jgdtn,jgdt, - & unpack,jskp,gfld,iret) - if ( iret.ne.0) then - if ( iret.eq.99 ) exit - print *,' getgb2 error = ',iret - cycle - !call errexit(17) - endif - icount=icount+1 - ! - ! Ensure that cgrib array is large enough - ! - if (gfld%ifldnum == 1 ) then ! start new GRIB2 message - npoints=gfld%ngrdpts - else - npoints=npoints+gfld%ngrdpts - endif - newlen=npoints*4 - if ( newlen.gt.currlen ) then - !if (allocated(cgrib)) deallocate(cgrib) - !allocate(cgrib(newlen),stat=is) - call realloc(cgrib,currlen,newlen,is) - currlen=newlen - endif - ! - ! Start new GRIB2 message, if necessary. - ! May have to finish the current message though. - ! - if (gfld%ifldnum == 1 ) then ! start new GRIB2 message - if (open_grb) then ! close previous GRIB2 message first - call gribend(cgrib,lcgrib,lengrib,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR ending new GRIB2 message = ',ierr - cycle - endif - open_grb=.false. - call wryte(ifl2,lengrib,cgrib) - endif - ! - ! Create new GRIB Message - ! - listsec0(1)=gfld%discipline - listsec0(2)=gfld%version - call gribcreate(cgrib,lcgrib,listsec0,gfld%idsect,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR creating new GRIB2 field = ',ierr - cycle - endif - open_grb=.true. - endif - ! - ! Add grid to GRIB message, if previous grid in same - ! message is not the same. - ! - previgds=igds - igds(1)=gfld%griddef - igds(2)=gfld%ngrdpts - igds(3)=gfld%numoct_opt - igds(4)=gfld%interp_opt - igds(5)=gfld%igdtnum - if ( .NOT. associated(gfld%list_opt) ) - & allocate(gfld%list_opt(1)) - if (gfld%ifldnum == 1 ) then ! add grid to GRIB2 message - call addgrid(cgrib,lcgrib,igds,gfld%igdtmpl,gfld%igdtlen, - & gfld%list_opt,gfld%num_opt,ierr) - else ! check if previous grid is the same as the current - if ( gfld%igdtlen.ne.prevfld%igdtlen .OR. - & gfld%num_opt.ne.prevfld%num_opt .OR. - & any(igds.ne.previgds) .OR. - & any(gfld%igdtmpl(1:gfld%igdtlen).NE. - & prevfld%igdtmpl(1:prevfld%igdtlen)) .OR. - & any(gfld%list_opt(1:gfld%num_opt).NE. - & prevfld%list_opt(1:prevfld%num_opt)) ) then - call addgrid(cgrib,lcgrib,igds,gfld%igdtmpl,gfld%igdtlen, - & gfld%list_opt,gfld%num_opt,ierr) - endif - endif - if (ierr.ne.0) then - write(6,*) ' ERROR adding GRIB2 grid = ',ierr - cycle - endif - call gf_free(prevfld) - idrstmpl=0 - ! - ! if usemiss is specified, change any bitmaps to - ! missing value management for DRTs 5.2 and 5.3. - ! OR carry on missing value management for fields - ! already using it. - ! - if ( usemiss .AND. - & (ipack.eq.2 .OR. ipack.eq.31 .OR. ipack.eq.32) ) then - if ( gfld%ibmap.eq.0 .OR. gfld%ibmap.eq.254) then - ! change bit-map to missing value mngmt. - gfld%ibmap=255 - rmiss=minval(gfld%fld(1:gfld%ngrdpts)) - if ( rmiss .lt. -9999.0 ) then - rmiss=rmiss*10.0 - else - rmiss=-9999.0 - endif - do i=1,gfld%ngrdpts - if ( .NOT. gfld%bmap(i) ) then - gfld%fld(i)=rmiss - gfld%bmap(i)=.true. - endif - enddo - idrstmpl(7)=imiss ! Primary missing values - call mkieee(rmiss,idrstmpl(8),1) - elseif ( gfld%idrtnum.EQ.2 .OR. gfld%idrtnum.EQ.3 ) then - idrstmpl(7)=gfld%idrtmpl(7) ! Missing value mgmt - idrstmpl(8)=gfld%idrtmpl(8) ! Primary missing value - idrstmpl(9)=gfld%idrtmpl(9) ! Secondary missing value - endif - endif - ! - ! If converting from a field using missing value management - ! in DRTs 5.2 and 5.3 to a DRT that does not support missing - ! values, convert missings to a bitmap. - ! - if ( (.NOT. usemiss) .AND. - & ( gfld%idrtnum.EQ.2 .OR. gfld%idrtnum.EQ.3 ) .AND. - & ( gfld%idrtmpl(7).EQ.1 .OR. gfld%idrtmpl(7).EQ.2) ) then - call rdieee(gfld%idrtmpl(8),rmissp,1) - if ( gfld%idrtmpl(7) .EQ. 2) then - call rdieee(gfld%idrtmpl(9),rmisss,1) - else - rmisss=rmissp - endif - allocate(gfld%bmap(gfld%ngrdpts)) - do j=1,gfld%ngrdpts - if ( gfld%fld(j).EQ.rmissp .OR. - & gfld%fld(j).EQ.rmisss ) then - gfld%bmap(j)=.false. - else - gfld%bmap(j)=.true. - endif - enddo - gfld%ibmap=0 - idrstmpl(7)=0 - idrstmpl(8)=0 - idrstmpl(9)=0 - endif - ! - ! Add field to GRIB message - ! - ! Set DRT info ( packing info ) - if ( ipack.eq.0 ) then - idrsnum=0 - elseif ( ipack.eq.2 ) then - idrsnum=2 - idrstmpl(6)=1 - elseif ( ipack.eq.31.OR.ipack.eq.32 ) then - idrsnum=ipack/10 - idrstmpl(6)=1 - 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 - else - idrsnum=3 - idrstmpl(17)=1 ! order of s.d. - idrstmpl(6)=1 ! general group split - ctemp=param_get_abbrev(gfld%discipline,gfld%ipdtmpl(1), - & gfld%ipdtmpl(2)) - if (ctemp.eq.'A PCP ') idrsnum=2 - endif - idrstmpl(2)=gfld%idrtmpl(2) - idrstmpl(3)=gfld%idrtmpl(3) - if ( .NOT. associated(gfld%coord_list) ) - & allocate(gfld%coord_list(1)) - if ( gfld%ibmap.ne.0 .AND. gfld%ibmap.ne.254) then - if ( .NOT. associated(gfld%bmap) ) allocate(gfld%bmap(1)) - endif - ! - ! Add field to GRIB message - ! - call addfield(cgrib,lcgrib,gfld%ipdtnum,gfld%ipdtmpl, - & gfld%ipdtlen,gfld%coord_list,gfld%num_coord, - & idrsnum,idrstmpl,200, - & gfld%fld,gfld%ngrdpts,gfld%ibmap,gfld%bmap,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR adding GRIB2 field = ',ierr - cycle - endif - - enddo - - if (open_grb) then ! close last GRIB2 message - call gribend(cgrib,lcgrib,lengrib,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR ending new GRIB2 message = ',ierr - if (associated(cgrib)) deallocate(cgrib) - call gf_free(gfld) - call gf_free(prevfld) - return - endif - open_grb=.false. - call wryte(ifl2,lengrib,cgrib) - endif - - if (associated(cgrib)) deallocate(cgrib) - call gf_free(gfld) - call gf_free(prevfld) - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnvgrib.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnvgrib.f deleted file mode 100755 index 1782701112..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/cnvgrib.f +++ /dev/null @@ -1,157 +0,0 @@ - subroutine cnvgrib(gfilein, gfileout) -C$$$ MAIN PROGRAM DOCUMENTATION BLOCK -C -C MAIN PROGRAM: cnvgrib -C PRGMMR: Gilbert ORG: NP11 DATE: 2003-06-06 -C -C ABSTRACT: This program converts every GRIB field in a file from -C (1) GRIB1 to GRIB2 (2) GRIB2 to GRIB1 or (3) GRIB2 to GRIB2. -C -C PROGRAM HISTORY LOG: -C 2003-06-06 Gilbert -C 2008-05-14 Vuong Added the option -m0 (No explicit missing values -C included within the datavalues, modified the options -C and help messages -C -C USAGE: CALL usage(gfilein, gfileout) -C INPUT ARGUMENT LIST: -C gfilein - ouput option: -C 1 = print description of arguments -C otherwise, print command usage summary -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - integer :: inver=0,outver=0,ipack=-1 - character(len=500) :: gfilein,gfileout,copt - INTEGER(4) NARG,IARGC - logical :: usemiss=.false., uvvect=.true. -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - inver=1 - outver=2 - ipack=0 - uvvect=.false. - imiss=0 -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! 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 - 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 - call errmsg('cnvgrib: cannot open output GRIB file '// - & gfileout(1:NCGB)) - call errexit(4) - endif -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! convert grib file -! - if ((inver.eq.1).AND.(outver.eq.2)) then - call cnv12(ifl1,ifl2,ipack,usemiss,imiss,uvvect) - 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) - else - print *,' Unknown conversion option.' - call errexit(5) - endif -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! close grib files -! - CALL BACLOSE(ifl1,IOS) - CALL BACLOSE(ifl2,IOS) - - end - - subroutine usage(iopt) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: usage -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-06 -C -C ABSTRACT: This routine prints out the command "usage" -C or a brief description of the command line options. -C -C PROGRAM HISTORY LOG: -C 2003-06-06 Gilbert -C 2007-04-25 Vuong - Changed the cnvgrib_ver -C 2008-08-12 Vuong - Changed the cnvgrib_ver -C -C USAGE: CALL usage(iopt) -C INPUT ARGUMENT LIST: -C iopt - ouput option: -C 1 = print description of arguments -C otherwise, print command usage summary -C -C REMARKS: None -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - character(len=15) :: cnvgrib_ver="cnvgrib-1.1.8" - integer,intent(in) :: iopt - - if ( iopt.eq.0 ) then - call errmsg (' ') - call errmsg('Usage: cnvgrib [-h] {-g12|-g21|-g22} [-m|-m0]'// - & ' [-nv]') - call errmsg(' [{-p0|-p2|-p31|-p32|-p40'// - & '|-p41}] ingribfile outgribfile') - call errmsg (' ') - call errmsg('Usage: cnvgrib -h For helps and shows all'// - & ' options') - call errmsg (' ') - endif - - if ( iopt.eq.1 ) then - call errmsg (' ') - call errmsg('cnvgrib: version '//cnvgrib_ver) - call errmsg (' ') - call errmsg('Must use one of the following options:') - call errmsg(' -g12 converts GRIB1 to GRIB2') - call errmsg(' -g21 converts GRIB2 to GRIB1') - call errmsg(' -g22 converts GRIB2 to GRIB2 '// - & ' (used to change packing option)') - call errmsg (' ') - call errmsg('Optional packing options: (for use with '// - & ' -g12 and -g22 only)') - call errmsg(' -p0 simple packing') - call errmsg(' -p2 complex packing') - call errmsg(' -p31 complex pack with 1st order diffs') - call errmsg(' -p32 complex pack with 2nd order diffs') - call errmsg(' -p40 JPEG2000 encoding') - call errmsg(' -p41 PNG encoding') - call errmsg (' ') - call errmsg('Other Optional options: ') - call errmsg(' -nv Do not combine U, V wind components') - call errmsg (' ') - call errmsg(' Use missing value management'// - & ' instead of bitmap') - call errmsg(' (ONLY valid with Complex Packing options:'// - & ' -p2, -p31 or -p32 )') - call errmsg (' ') - call errmsg(' -m Primary missing values'// - & ' included within the data values') - call errmsg(' -m0 No explicit missing values'// - & ' included within the data values') - call errmsg (' ') - endif - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/gds2gdt.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/gds2gdt.f deleted file mode 100755 index 213c728037..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/gds2gdt.f +++ /dev/null @@ -1,360 +0,0 @@ - subroutine gds2gdt(kgds,igds,igdstmpl,idefnum,ideflist,iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: gds2gdt -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-17 -C -C ABSTRACT: This routine converts a GRIB1 GDS ( in format specfied in -C w3fi63.f) to necessary info for a GRIB2 Grid Definition Section. -C -C PROGRAM HISTORY LOG: -C 2003-06-17 Gilbert -C 2004-04-27 Gilbert - Added support for Gaussian grids. -C 2007-04-16 Vuong - Added Curvilinear Orthogonal grids. -C 2007-05-29 Vuong - Added Rotate Lat/Lon E-grid (203) -C -C USAGE: CALL gds2gdt(kgds,igds,igdstmpl,idefnum,ideflist,iret) -C INPUT ARGUMENT LIST: -C kgds() - GRIB1 GDS info as returned by w3fi63.f -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C igds() - Contains information read from the appropriate GRIB Grid -C Definition Section 3 for the field being returned. -C Must be dimensioned >= 5. -C igds(1)=Source of grid definition (see Code Table 3.0) -C igds(2)=Number of grid points in the defined grid. -C igds(3)=Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C igds(4)=Interpretation of list for optional points -C definition. (Code Table 3.11) -C igds(5)=Grid Definition Template Number (Code Table 3.1) -C igdstmpl() - Grid Definition Template values for GDT 3.igds(5) -C idefnum - The number of entries in array ideflist. -C i.e. number of rows ( or columns ) -C for which optional grid points are defined. -C ideflist() - Optional integer array containing -C the number of grid points contained in each row (or column). -C iret - Error return value: -C 0 = Successful -C 1 = Unrecognized GRIB1 grid data representation type -C -C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION -C -C ATTRIBUTES: -C LANGUAGE: INDICATE EXTENSIONS, COMPILER OPTIONS -C MACHINE: IBM SP -C -C$$$ -! - integer,intent(in) :: kgds(*) - integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*) - integer,intent(out) :: idefnum,iret - - iret=0 - if (kgds(1).eq.0) then ! Lat/Lon grid - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=0 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) !Ni - igdstmpl(9)=kgds(3) !Nj - igdstmpl(10)=0 - igdstmpl(11)=0 - igdstmpl(12)=kgds(4)*1000 ! Lat of 1st grid point - if ( kgds(5).lt.0 ) then ! Lon of 1st grid point - igdstmpl(13)=(360000+kgds(5))*1000 ! convert W to E - else - igdstmpl(13)=kgds(5)*1000 - endif - igdstmpl(14)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(14)=48 - if ( btest(kgds(6),3) ) igdstmpl(14)=igdstmpl(14)+8 - igdstmpl(15)=kgds(7)*1000 ! Lat of last grid point - if ( kgds(8).lt.0 ) then ! Lon of last grid point - igdstmpl(16)=(360000+kgds(8))*1000 ! convert W to E - else - igdstmpl(16)=kgds(8)*1000 - endif - igdstmpl(17)=kgds(9)*1000 ! Di - igdstmpl(18)=kgds(10)*1000 ! Dj - igdstmpl(19)=kgds(11) ! Scanning mode - if (kgds(20).ne.255) then ! irregular grid (eg WAFS) - igds(2)=kgds(21) ! num of grid points - !idefnum=kgds(19) - if (kgds(2).eq.65535) idefnum=kgds(3) - if (kgds(3).eq.65535) idefnum=kgds(2) - imax=0 - do j=1,idefnum - ideflist(j)=kgds(21+j) - if (ideflist(j).gt.imax) imax=ideflist(j) - enddo - igds(3)=1 ! octets for further grid definition - if (imax.gt.255) igds(3)=2 - if (imax.gt.65535) igds(3)=3 - if (imax.gt.16777215) igds(3)=4 - igds(4)=1 ! interpretation of optional list - igdstmpl(8)=-1 - igdstmpl(17)=-1 - endif - elseif (kgds(1).eq.1) then ! Mercator grid - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=10 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) ! Ni - igdstmpl(9)=kgds(3) ! Nj - igdstmpl(10)=kgds(4)*1000 ! Lat of 1st grid point - if ( kgds(5).lt.0 ) then ! Lon of 1st grid point - igdstmpl(11)=(360000+kgds(5))*1000 ! convert W to E - else - igdstmpl(11)=kgds(5)*1000 - endif - igdstmpl(12)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(12)=48 - if ( btest(kgds(6),3) ) igdstmpl(12)=igdstmpl(12)+8 - igdstmpl(13)=kgds(9)*1000 ! Lat intersects earth - igdstmpl(14)=kgds(7)*1000 ! Lat of last grid point - if ( kgds(8).lt.0 ) then ! Lon of last grid point - igdstmpl(15)=(360000+kgds(8))*1000 ! convert W to E - else - igdstmpl(15)=kgds(8)*1000 - endif - igdstmpl(16)=kgds(11) ! Scanning mode - igdstmpl(17)=0 ! Orientation of grid - igdstmpl(18)=kgds(12)*1000 ! Di - igdstmpl(19)=kgds(13)*1000 ! Dj - elseif (kgds(1).eq.3) then ! Lambert Conformal Grid - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=30 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) ! Nx - igdstmpl(9)=kgds(3) ! Ny - igdstmpl(10)=kgds(4)*1000 ! Lat of 1st grid point - if ( kgds(5).lt.0 ) then ! Lon of 1st grid point - igdstmpl(11)=(360000+kgds(5))*1000 ! convert W to E - else - igdstmpl(11)=kgds(5)*1000 - endif - igdstmpl(12)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(12)=48 - if ( btest(kgds(6),3) ) igdstmpl(12)=igdstmpl(12)+8 - igdstmpl(13)=kgds(12)*1000 ! Lat where Dx and Dy specified - if ( kgds(7).lt.0 ) then ! Lon of orientation - igdstmpl(14)=(360000+kgds(7))*1000 ! convert W to E - else - igdstmpl(14)=kgds(7)*1000 - endif - igdstmpl(15)=kgds(8)*1000 ! Dx - igdstmpl(16)=kgds(9)*1000 ! Dy - igdstmpl(17)=kgds(10) ! Projection Center Flag - igdstmpl(18)=kgds(11) ! Scanning mode - igdstmpl(19)=kgds(12)*1000 ! Latin 1 - igdstmpl(20)=kgds(13)*1000 ! Latin 2 - igdstmpl(21)=kgds(14)*1000 ! Lat of S. Pole of projection - if ( kgds(15).lt.0 ) then ! Lon of S. Pole of projection - igdstmpl(22)=(360000+kgds(15))*1000 ! convert W to E - else - igdstmpl(22)=kgds(15)*1000 - endif - elseif (kgds(1).eq.4) then ! Gaussian Lat/Lon grid - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=40 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) !Ni - igdstmpl(9)=kgds(3) !Nj - igdstmpl(10)=0 - igdstmpl(11)=0 - igdstmpl(12)=kgds(4)*1000 ! Lat of 1st grid point - if ( kgds(5).lt.0 ) then ! Lon of 1st grid point - igdstmpl(13)=(360000+kgds(5))*1000 ! convert W to E - else - igdstmpl(13)=kgds(5)*1000 - endif - igdstmpl(14)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(14)=48 - if ( btest(kgds(6),3) ) igdstmpl(14)=igdstmpl(14)+8 - igdstmpl(15)=kgds(7)*1000 ! Lat of last grid point - if ( kgds(8).lt.0 ) then ! Lon of last grid point - igdstmpl(16)=(360000+kgds(8))*1000 ! convert W to E - else - igdstmpl(16)=kgds(8)*1000 - endif - igdstmpl(17)=kgds(9)*1000 ! Di - igdstmpl(18)=kgds(10) ! D - Number of parallels - igdstmpl(19)=kgds(11) ! Scanning mode - elseif (kgds(1).eq.5) then ! Polar Stereographic Grid - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=20 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) ! Nx - igdstmpl(9)=kgds(3) ! Ny - igdstmpl(10)=kgds(4)*1000 ! Lat of 1st grid point - if ( kgds(5).lt.0 ) then ! Lon of 1st grid point - igdstmpl(11)=(360000+kgds(5))*1000 ! convert W to E - else - igdstmpl(11)=kgds(5)*1000 - endif - igdstmpl(12)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(12)=48 - if ( btest(kgds(6),3) ) igdstmpl(12)=igdstmpl(12)+8 - igdstmpl(13)=60000000 ! Lat where Dx and Dy specified - if ( btest(kgds(10),7) ) igdstmpl(13)=-60000000 - if ( kgds(7).lt.0 ) then ! Lon of orientation - igdstmpl(14)=(360000+kgds(7))*1000 ! convert W to E - else - igdstmpl(14)=kgds(7)*1000 - endif - igdstmpl(15)=kgds(8)*1000 ! Dx - igdstmpl(16)=kgds(9)*1000 ! Dy - igdstmpl(17)=kgds(10) ! Projection Center Flag - igdstmpl(18)=kgds(11) ! Scanning mode - elseif (kgds(1).eq.204) then ! Curivilinear Orthogonal Grid (Used by RTOFS) - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=204 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) !Ni - No of points along x-grid direction - igdstmpl(9)=kgds(3) !Nj - No of points along y-grid direction - igdstmpl(10)=0 - igdstmpl(11)=0 - igdstmpl(12)=0 - igdstmpl(13)=0 - igdstmpl(14)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(14)=48 - if ( btest(kgds(6),3) ) igdstmpl(14)=igdstmpl(14)+8 - igdstmpl(15)=0 - igdstmpl(16)=0 - igdstmpl(17)=0 - igdstmpl(18)=0 - igdstmpl(19)=kgds(11) ! Scanning mode - elseif (kgds(1).eq.203) then ! Rot Lat/Lon grid (Arakawa) - idefnum=0 - igds(1)=0 ! grid def specfied in template - igds(2)=kgds(2)*kgds(3) ! num of grid points - igds(3)=0 ! octets for further grid definition - igds(4)=0 ! interpretation of optional list - igds(5)=32768 ! Grid Definition Template number - if ( btest(kgds(6),6) ) then ! shape of Earth - igdstmpl(1)=2 - else - igdstmpl(1)=0 - endif - igdstmpl(2)=0 - igdstmpl(3)=0 - igdstmpl(4)=0 - igdstmpl(5)=0 - igdstmpl(6)=0 - igdstmpl(7)=0 - igdstmpl(8)=kgds(2) !Ni - igdstmpl(9)=kgds(3) !Nj - igdstmpl(10)=0 - igdstmpl(11)=0 - igdstmpl(12)=kgds(4)*1000 ! Lat of 1st grid point - if ( kgds(5).lt.0 ) then ! Lon of 1st grid point - igdstmpl(13)=(360000+kgds(5))*1000 ! convert W to E - else - igdstmpl(13)=kgds(5)*1000 - endif - igdstmpl(14)=0 ! Resolution and Component flags - if ( btest(kgds(6),7) ) igdstmpl(14)=48 - if ( btest(kgds(6),3) ) igdstmpl(14)=igdstmpl(14)+8 - igdstmpl(15)=kgds(7)*1000 ! Lat of last grid point - if ( kgds(8).lt.0 ) then ! Lon of last grid point - igdstmpl(16)=(360000+kgds(8))*1000 ! convert W to E - else - igdstmpl(16)=kgds(8)*1000 - endif - igdstmpl(17)=kgds(9)*1000 ! Di - igdstmpl(18)=kgds(10)*1000 ! Dj - igdstmpl(19)=kgds(11) ! Scanning mode - else - Print *,'gds2gdt: Unrecognized GRIB1 Grid type = ',kgds(1) - iret=1 - endif - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/gdt2gds.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/gdt2gds.f deleted file mode 100755 index 19fd845e36..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/gdt2gds.f +++ /dev/null @@ -1,362 +0,0 @@ - subroutine gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds, - & igrid,iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: gdt2gds -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-17 -C -C ABSTRACT: This routine converts grid information from a GRIB2 -C Grid Description Section as well as its -C Grid Definition Template to GRIB1 GDS info. In addition, -C a check is made to determine if the grid is an NCEP -C predefined grid. -C -C PROGRAM HISTORY LOG: -C 2003-06-17 Gilbert -C 2004-04-27 Gilbert - Added support for gaussian grids. -C 2007-04-16 Vuong - Added Curvilinear Orthogonal grids. -C 2007-05-29 Vuong - Added Rotate Lat/Lon E-grid (203) -C -C USAGE: CALL gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds,igrid,iret) -C INPUT ARGUMENT LIST: -C igds() - Contains information read from the appropriate GRIB Grid -C Definition Section 3 for the field being returned. -C Must be dimensioned >= 5. -C igds(1)=Source of grid definition (see Code Table 3.0) -C igds(2)=Number of grid points in the defined grid. -C igds(3)=Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C igds(4)=Interpretation of list for optional points -C definition. (Code Table 3.11) -C igds(5)=Grid Definition Template Number (Code Table 3.1) -C igdstmpl() - Grid Definition Template values for GDT 3.igds(5) -C idefnum - The number of entries in array ideflist. -C i.e. number of rows ( or columns ) -C for which optional grid points are defined. -C ideflist() - Optional integer array containing -C the number of grid points contained in each row (or column). -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C kgds() - GRIB1 GDS as described in w3fi63 format. -C igrid - NCEP predefined GRIB1 grid number -C set to 255, if not NCEP grid -C iret - Error return value: -C 0 = Successful -C 1 = Unrecognized GRIB2 GDT number 3.igds(5) -C -C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION -C -C ATTRIBUTES: -C LANGUAGE: INDICATE EXTENSIONS, COMPILER OPTIONS -C MACHINE: IBM SP -C -C$$$ -! - integer,intent(in) :: idefnum - integer,intent(in) :: igds(*),igdstmpl(*),ideflist(*) - integer,intent(out) :: kgds(*),igrid,iret - - integer :: kgds72(200),kgds71(200),idum(200),jdum(200) - - iret=0 - if (igds(5).eq.0) then ! Lat/Lon grid - kgds(1)=0 - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(12)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(13)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(15)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(16)/1000 ! Long of last grid point - kgds(9)=igdstmpl(17)/1000 ! Di - kgds(10)=igdstmpl(18)/1000 ! Dj - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - ! - ! Process irreg grid stuff, if necessary - ! - if ( idefnum.ne.0 ) then - if ( igdstmpl(8).eq.-1 ) then - kgds(2)=65535 - kgds(9)=65535 - endif - if ( igdstmpl(9).eq.-1 ) then - kgds(3)=65535 - kgds(10)=65535 - endif - kgds(19)=0 - kgds(20)=33 - if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43 - kgds(21)=igds(2) ! num of grid points - do j=1,idefnum - kgds(21+j)=ideflist(j) - enddo - endif - elseif (igds(5).eq.10) then ! Mercator grid - kgds(1)=1 ! Grid Definition Template number - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(10)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(11)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(14)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(15)/1000 ! Long of last grid point - kgds(9)=igdstmpl(13)/1000 ! Lat intersects earth - kgds(10)=0 - kgds(11)=igdstmpl(16) ! Scanning mode - kgds(12)=igdstmpl(18)/1000 ! Di - kgds(13)=igdstmpl(19)/1000 ! Dj - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.30) then ! Lambert Conformal Grid - kgds(1)=3 - kgds(2)=igdstmpl(8) ! Nx - kgds(3)=igdstmpl(9) ! Ny - kgds(4)=igdstmpl(10)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(11)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(14)/1000 ! Lon of orientation - kgds(8)=igdstmpl(15)/1000 ! Dx - kgds(9)=igdstmpl(16)/1000 ! Dy - kgds(10)=igdstmpl(17) ! Projection Center Flag - kgds(11)=igdstmpl(18) ! Scanning mode - kgds(12)=igdstmpl(19)/1000 ! Lat in 1 - kgds(13)=igdstmpl(20)/1000 ! Lat in 2 - kgds(14)=igdstmpl(21)/1000 ! Lat of S. Pole of projection - kgds(15)=igdstmpl(22)/1000 ! Lon of S. Pole of projection - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.40) then ! Gaussian Lat/Lon grid - kgds(1)=4 - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(12)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(13)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(15)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(16)/1000 ! Long of last grid point - kgds(9)=igdstmpl(17)/1000 ! Di - kgds(10)=igdstmpl(18) ! N - Number of parallels - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.20) then ! Polar Stereographic Grid - kgds(1)=5 - kgds(2)=igdstmpl(8) ! Nx - kgds(3)=igdstmpl(9) ! Ny - kgds(4)=igdstmpl(10)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(11)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(14)/1000 ! Lon of orientation - kgds(8)=igdstmpl(15)/1000 ! Dx - kgds(9)=igdstmpl(16)/1000 ! Dy - kgds(10)=igdstmpl(17) ! Projection Center Flag - kgds(11)=igdstmpl(18) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.204) then ! Curvilinear Orthogonal - kgds(1)=204 - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=0 - kgds(5)=0 - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=0 - kgds(8)=0 - kgds(9)=0 - kgds(10)=0 - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - ! - ! Process irreg grid stuff, if necessary - ! - if ( idefnum.ne.0 ) then - if ( igdstmpl(8).eq.-1 ) then - kgds(2)=65535 - kgds(9)=65535 - endif - if ( igdstmpl(9).eq.-1 ) then - kgds(3)=65535 - kgds(10)=65535 - endif - kgds(19)=0 - kgds(20)=33 - if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43 - kgds(21)=igds(2) ! num of grid points - do j=1,idefnum - kgds(21+j)=ideflist(j) - enddo - endif - elseif (igds(5).eq.32768) then ! Rotate Lat/Lon grid - kgds(1)=0 ! Arakawa Staggerred E/B grid - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(12)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(13)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(15)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(16)/1000 ! Long of last grid point - kgds(9)=igdstmpl(17)/1000 ! Di - kgds(10)=igdstmpl(18)/1000 ! Dj - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - ! - ! Process irreg grid stuff, if necessary - ! - if ( idefnum.ne.0 ) then - if ( igdstmpl(8).eq.-1 ) then - kgds(2)=65535 - kgds(9)=65535 - endif - if ( igdstmpl(9).eq.-1 ) then - kgds(3)=65535 - kgds(10)=65535 - endif - kgds(19)=0 - kgds(20)=33 - if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43 - kgds(21)=igds(2) ! num of grid points - do j=1,idefnum - kgds(21+j)=ideflist(j) - enddo - endif - else - Print *,'gdt2gds: Unrecognized GRIB2 GDT = 3.',igds(5) - iret=1 - kgds(1:22)=0 - return - endif -! -! Can we determine NCEP grid number ? -! - igrid=255 - do j=254,1,-1 - !do j=225,225 - kgds71=0 - kgds72=0 - call w3fi71(j,kgds71,ierr) - if ( ierr.ne.0 ) cycle - ! convert W to E for longitudes - if ( kgds71(3).eq.0 ) then ! lat/lon - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10) - elseif ( kgds71(3).eq.1 ) then ! mercator - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10) - elseif ( kgds71(3).eq.3 ) then ! lambert conformal - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(9).lt.0 ) kgds71(9)=360000+kgds71(9) - if ( kgds71(18).lt.0 ) kgds71(18)=360000+kgds71(18) - elseif ( kgds71(3).eq.4 ) then ! Guassian lat/lon - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10) - elseif ( kgds71(3).eq.5 ) then ! polar stereographic - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(9).lt.0 ) kgds71(9)=360000+kgds71(9) - endif - call r63w72(idum,kgds,jdum,kgds72) - if ( kgds72(3).eq.3 ) kgds72(14)=0 ! lambert conformal fix - if ( kgds72(3).eq.1 ) kgds72(15:18)=0 ! mercator fix - if ( kgds72(3).eq.5 ) kgds72(14:18)=0 ! polar str fix -c print *,' kgds71(',j,')= ', kgds71(1:30) -c print *,' kgds72 = ', kgds72(1:30) - if ( all(kgds71.eq.kgds72) ) then - igrid=j - return - endif - enddo - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makefile b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makefile deleted file mode 100755 index bab9549398..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makefile +++ /dev/null @@ -1,59 +0,0 @@ -SHELL=/bin/sh -# -SRCS= gds2gdt.f pds2pdt.f pds2pdtens.f cnvgrib.f cnv12.f cnv22.f \ - cnv21.f gdt2gds.f makepds.f putgbexn.f makepdsens.f setbit.f -OBJS= gds2gdt.o pds2pdt.o pds2pdtens.o cnvgrib.o cnv12.o cnv22.o \ - cnv21.o gdt2gds.o makepds.o putgbexn.o makepdsens.o setbit.o - -# Tunable parameters -# -# FC Name of the fortran compiling system to use -# LDFLAGS Flags to the loader -# LIBS List of libraries -# CMD Name of the executable -# PROFLIB Library needed for profiling -# -FC = gfortran -LDFLAGS = -#LDFLAGS = -pg -INC = -I . -I/home/brockwoo/workspace/ncepLib/org.ncep.grib/include -I/home/brockwoo/workspace/ncepLib/org.ncep.grib/src/g2lib-1.1.8 -LIBS = -L/home/brockwoo/workspace/ncepLib/org.ncep.grib/lib -L/common/brockwoo/awips/lib -lg2 -lw3 -ljasper -lpng -lz - -CMD = libcnvgrib.so -PROFLIB = -lprof - -# To perform the default compilation, use the first line -# To compile with flowtracing turned on, use the second line -# To compile giving profile additonal information, use the third line -# WARNING: SIMULTANEOUSLY PROFILING AND FLOWTRACING IS NOT RECOMMENDED -#FFLAGS = -O3 -pg -qrealsize=4 $(INC) -FFLAGS = -g $(INC) -O2 -fPIC -#FFLAGS = -F -#FFLAGS = -Wf"-ez" - -# Lines from here on down should not need to be changed. They are the -# actual rules which make uses to build a.out. -# -all: $(CMD) - -$(CMD): $(OBJS) - $(FC) $(LDFLAGS) -shared -fPIC -o $(@) $(OBJS) $(LIBS) - - -#$(CMD): $(OBJS) -# $(FC) $(LDFLAGS) -shared -o lib$(@).so $(OBJS) $(LIBS) - -# Make the profiled version of the command and call it a.out.prof -# - -$(CMD).prof: $(OBJS) - $(FC) $(LDFLAGS) -shared -o lib$(@).so $(OBJS) $(PROFLIB) $(LIBS) - -clean: - -rm -f $(OBJS) - -clobber: clean - -rm -f $(CMD) $(CMD).prof - -void: clobber - -rm -f $(SRCS) makefile diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makefile.1 b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makefile.1 deleted file mode 100755 index 3010e88609..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makefile.1 +++ /dev/null @@ -1,59 +0,0 @@ -SHELL=/bin/sh -# -SRCS= gds2gdt.f pds2pdt.f pds2pdtens.f cnvgrib.f cnv12.f cnv22.f \ - cnv21.f gdt2gds.f makepds.f putgbexn.f makepdsens.f setbit.f -OBJS= gds2gdt.o pds2pdt.o pds2pdtens.o cnvgrib.o cnv12.o cnv22.o \ - cnv21.o gdt2gds.o makepds.o putgbexn.o makepdsens.o setbit.o - -# Tunable parameters -# -# FC Name of the fortran compiling system to use -# LDFLAGS Flags to the loader -# LIBS List of libraries -# CMD Name of the executable -# PROFLIB Library needed for profiling -# -FC = gfortran -LDFLAGS = -#LDFLAGS = -pg -INC = -I . -I/home/brockwoo/workspace/ncepLib/org.ncep.grib/include -I/home/brockwoo/workspace/ncepLib/org.ncep.grib/src/g2lib-1.1.8 -LIBS = -L/home/brockwoo/workspace/ncepLib/org.ncep.grib/lib -lg2 -lw3 -ljasper -lpng -lz - -CMD = cnvgrib -PROFLIB = -lprof - -# To perform the default compilation, use the first line -# To compile with flowtracing turned on, use the second line -# To compile giving profile additonal information, use the third line -# WARNING: SIMULTANEOUSLY PROFILING AND FLOWTRACING IS NOT RECOMMENDED -#FFLAGS = -O3 -pg -qrealsize=4 $(INC) -FFLAGS = -g $(INC) -O2 -#FFLAGS = -F -#FFLAGS = -Wf"-ez" - -# Lines from here on down should not need to be changed. They are the -# actual rules which make uses to build a.out. -# -all: $(CMD) - -$(CMD): $(OBJS) - $(FC) $(LDFLAGS) -o $(@) $(OBJS) $(LIBS) - - -#$(CMD): $(OBJS) -# $(FC) $(LDFLAGS) -shared -o lib$(@).so $(OBJS) $(LIBS) - -# Make the profiled version of the command and call it a.out.prof -# - -$(CMD).prof: $(OBJS) - $(FC) $(LDFLAGS) -shared -o lib$(@).so $(OBJS) $(PROFLIB) $(LIBS) - -clean: - -rm -f $(OBJS) - -clobber: clean - -rm -f $(CMD) $(CMD).prof - -void: clobber - -rm -f $(SRCS) makefile diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makepds.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makepds.f deleted file mode 100755 index 780f3c60be..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makepds.f +++ /dev/null @@ -1,399 +0,0 @@ - subroutine makepds(idisc,idsect,ipdsnum,ipdstmpl,ibmap, - & idrsnum,idrstmpl,kpds,iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: makepds -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12 -C -C ABSTRACT: This routine creates a GRIB1 PDS (Section 1) -C from appropriate information from a GRIB2 Product Definition Template. -C -C PROGRAM HISTORY LOG: -C 2003-06-12 Gilbert -C 2005-04-19 Gilbert - Changed scaling factor used with potential -C vorticity surfaces. -C 2007-05-08 VUONG - Add Product Definition Template entries -C 120 - Ice Concentration Analysis -C 121 - Western North Atlantic Regional Wave Model -C 122 - Alaska Waters Regional Wave Model -C 123 - North Atlantic Hurricane Wave Model -C 124 - Eastern North Pacific Regional Wave Model -C 131 - Great Lake Wave Model -C 88 - NOAA Wave Watch III (NWW3) -C 45 - Coastal Ocean Circulation -C 47 - HYCOM - North Pacific basin -C 2007-05-14 Boi Vuong - Added Time Range Indicator 51 (Climatological -C Mean Value) -C 2007-10-24 Boi Vuong - Added level 8 (Nominal top of atmosphere) -C -C USAGE: CALL makepds(idisc,idsect,ipdsnum,ipdstmpl,ibmap, -C idrsnum,idrstmpl,kpds,iret) -C INPUT ARGUMENT LIST: -C idisc - GRIB2 discipline from Section 0. -C idsect() - GRIB2 Section 1 info. -C idsect(1)=Id of orginating centre (Common Code Table C-1) -C idsect(2)=Id of orginating sub-centre (local table) -C idsect(3)=GRIB Master Tables Version Number (Code Table 1.0) -C idsect(4)=GRIB Local Tables Version Number (Code Table 1.1) -C idsect(5)=Significance of Reference Time (Code Table 1.2) -C idsect(6)=Reference Time - Year (4 digits) -C idsect(7)=Reference Time - Month -C idsect(8)=Reference Time - Day -C idsect(9)=Reference Time - Hour -C idsect(10)=Reference Time - Minute -C idsect(11)=Reference Time - Second -C idsect(12)=Production status of data (Code Table 1.3) -C idsect(13)=Type of processed data (Code Table 1.4) -C ipdsnum - GRIB2 Product Definition Template Number -C ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum -C ibmap - GRIB2 bitmap indicator from octet 6, Section 6. -C idrsnum - GRIB2 Data Representation Template Number -C idrstmpl() - GRIB2 Data Representation Template entries -C -C OUTPUT ARGUMENT LIST: -C kpds() - GRIB1 PDS info as specified in W3FI63. -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C iret - Error return value: -C 0 = Successful -C 1 = Don't know what to do with pre-defined bitmap. -C 2 = Unrecognized GRIB2 PDT 4.ipdsnum -C -C REMARKS: Use pds2pdtens for ensemble related PDS -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use params - - integer,intent(in) :: idsect(*),ipdstmpl(*),idrstmpl(*) - integer,intent(in) :: ipdsnum,idisc,idrsnum,ibmap - integer,intent(out) :: kpds(*) - integer,intent(out) :: iret - - iret=0 - kpds(1:24)=0 - if ( (ipdsnum.lt.0).OR.(ipdsnum.gt.14) ) then - print *,'makepds: Don:t know GRIB2 PDT 4.',ipdsnum - iret=2 - return - endif - - kpds(1)=idsect(1) - kpds(2)=ipdstmpl(5) - kpds(3)=255 - kpds(4)=128 - if ( ibmap.ne.255 ) kpds(4)=kpds(4)+64 - if ( ibmap.ge.1.AND.ibmap.le.253 ) then - print *,'makepds: Don:t know about predefined bit-map ',ibmap - iret=1 - return - endif - call param_g2_to_g1(idisc,ipdstmpl(1),ipdstmpl(2),kpds(5), - & kpds(19)) - call levelcnv(ipdstmpl,kpds(6),kpds(7)) ! level - kpds(8)=mod(idsect(6),100) - if ( kpds(8).eq.0 ) kpds(8)=100 - kpds(9)=idsect(7) ! Year - kpds(10)=idsect(8) ! Month - kpds(11)=idsect(9) ! Day - kpds(12)=idsect(10) ! Hour - if ( ipdstmpl(8).ne.13 ) then - kpds(13)=ipdstmpl(8) ! Time Unit - else - kpds(13)=254 - endif - kpds(14)=ipdstmpl(9) ! P1 - if ( ipdsnum.le.7 ) then ! P2 - kpds(15)=0 - kpds(16)=0 - kpds(20)=0 - if ( kpds(14).eq.0 ) kpds(16)=1 - if ( kpds(14).gt.255 ) kpds(16)=10 - if ( ipdstmpl(5).eq.77.OR.ipdstmpl(5).eq.81.OR. - & ipdstmpl(5).eq.96.OR.ipdstmpl(5).eq.80.OR. - & ipdstmpl(5).eq.82.OR.ipdstmpl(5).eq.120.OR. - & ipdstmpl(5).eq.47.OR.ipdstmpl(5).eq.11 ) then - kpds(16)=10 - end if - if (ipdstmpl(5).eq.84.AND.kpds(5).eq.154)kpds(16) = 10 -C -C NOAA Wave Watch III and Coastal Ocean Circulation -C and Alaska Waters Regional Wave Model -C - if ( ipdstmpl(5).eq.88.OR.ipdstmpl(5).eq.121 - & .OR.ipdstmpl(5).eq.122.OR.ipdstmpl(5).eq.123 - & .OR.ipdstmpl(5).eq.124.OR.ipdstmpl(5).eq.125 - & .OR.ipdstmpl(5).eq.131.OR.ipdstmpl(5).eq.45 - & .OR.ipdstmpl(5).eq.11 ) then - kpds(16) = 0 -C -C Level Surface set to 1 -C - if (kpds(5).eq.80.OR.kpds(5).eq.82.OR. - & kpds(5).eq.88.OR.kpds(5).eq.49.OR. - & kpds(5).eq.50) kpds(7)=1 ! Level Surface - if (ipdstmpl(5).eq.122.OR.ipdstmpl(5).eq.124.OR. - & ipdstmpl(5).eq.131.OR.ipdstmpl(5).eq.123.OR. - & ipdstmpl(5).eq.125.OR.ipdstmpl(5).eq.88.OR. - & ipdstmpl(5).eq.121) kpds(7)=1 - if (idsect(1).eq.54.AND.ipdstmpl(5).eq.45) kpds(16) = 10 - endif - else - selectcase (ipdsnum) - case(8) - ipos=24 - case(9) - ipos=31 - case(10) - ipos=25 - case(11) - ipos=27 - case(12) - ipos=26 - case(13) - ipos=40 - case(14) - ipos=39 - end select - kpds(15)=ipdstmpl(ipos+3)+kpds(14) - selectcase (ipdstmpl(ipos)) - case (255) - kpds(16)=2 - case (0) - kpds(16)=3 - case (1) - kpds(16)=4 - case (2) - kpds(16)=2 - case (3) - kpds(16)=2 - case (4) - kpds(16)=5 - case (51) - kpds(16)=51 - end select - kpds(20)=ipdstmpl(ipos-1) - endif - kpds(17)=0 - kpds(18)=1 ! GRIB edition - kpds(21)=(idsect(6)/100)+1 ! Century - if ( kpds(8).eq.100 ) kpds(21)=idsect(6)/100 - kpds(22)=idrstmpl(3) ! Decimal scale factor - kpds(23)=idsect(2) ! Sub-center - return - end - - - subroutine levelcnv(ipdstmpl,ltype,lval) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: levelcnv -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12 -C -C ABSTRACT: this routine converts Level/layer information -C from a GRIB2 Product Definition Template to GRIB1 -C Level type and Level value. -C -C PROGRAM HISTORY LOG: -C 2003-06-12 Gilbert -C 2007-10-24 Boi Vuong - Added level 8 (Nominal top of atmosphere) -C -C USAGE: CALL levelcnv(ipdstmpl,ltype,lval) -C INPUT ARGUMENT LIST: -C ipdstmpl() - GRIB2 Product Definition Template values -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C ltype - GRIB1 level type (PDS octet 10) -C lval - GRIB1 level/layer value(s) (PDS octets 11 and 12) -C -C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - integer,intent(in) :: ipdstmpl(*) - integer,intent(out) :: ltype,lval - - ltype=255 - lval=0 - ltype1=ipdstmpl(10) - ltype2=ipdstmpl(13) - - if ( ltype1.lt.100.AND.ltype2.eq.255 ) then - ltype=ltype1 - lval=0 - elseif ( ltype1.eq.1.AND.ltype2.eq.8 ) then - ltype=ltype1 - lval=0 - elseif ( ltype1.ge.200.AND.ltype2.eq.255 ) then - ltype=ltype1 - lval=0 - elseif (ltype1.eq.100.AND.ltype2.eq.255 ) then - ltype=100 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1/100.) - elseif (ltype1.eq.100.AND.ltype2.eq.100 ) then - ltype=101 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1/1000.) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2/1000.) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.101.AND.ltype2.eq.255 ) then - ltype=102 - lval=0 - elseif (ltype1.eq.102.AND.ltype2.eq.255 ) then - ltype=103 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1) - elseif (ltype1.eq.102.AND.ltype2.eq.102 ) then - ltype=104 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.103.AND.ltype2.eq.255 ) then - ltype=105 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1) - elseif (ltype1.eq.103.AND.ltype2.eq.103 ) then - ltype=106 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1/100.) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2/100.) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.104.AND.ltype2.eq.255 ) then - ltype=107 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1*10000.) - elseif (ltype1.eq.104.AND.ltype2.eq.104 ) then - ltype=108 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1*100.) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2*100.) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.105.AND.ltype2.eq.255 ) then - ltype=109 - lval=ipdstmpl(12) - elseif (ltype1.eq.105.AND.ltype2.eq.105 ) then - ltype=110 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.106.AND.ltype2.eq.255 ) then - ltype=111 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1*100.) - elseif (ltype1.eq.106.AND.ltype2.eq.106 ) then - ltype=112 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1*100.) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2*100.) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.107.AND.ltype2.eq.255 ) then - ltype=113 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1) - elseif (ltype1.eq.107.AND.ltype2.eq.107 ) then - ltype=114 - rscal1=10.**(-ipdstmpl(11)) - lval1=475-nint(real(ipdstmpl(12))*rscal1) - rscal2=10.**(-ipdstmpl(14)) - lval2=475-nint(real(ipdstmpl(15))*rscal2) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.108.AND.ltype2.eq.255 ) then - ltype=115 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1/100.) - elseif (ltype1.eq.108.AND.ltype2.eq.108 ) then - ltype=116 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1/100.) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2/100.) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.109.AND.ltype2.eq.255 ) then - ltype=117 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1*1000000000.) - elseif (ltype1.eq.111.AND.ltype2.eq.255 ) then - ltype=119 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1*10000.) - elseif (ltype1.eq.111.AND.ltype2.eq.111 ) then - ltype=120 - rscal1=10.**(-ipdstmpl(11)) - lval1=nint(real(ipdstmpl(12))*rscal1*100.) - rscal2=10.**(-ipdstmpl(14)) - lval2=nint(real(ipdstmpl(15))*rscal2*100.) - lval=(lval1*256)+lval2 - elseif (ltype1.eq.160.AND.ltype2.eq.255 ) then - ltype=160 - rscal1=10.**(-ipdstmpl(11)) - lval=nint(real(ipdstmpl(12))*rscal1) - else - print *,'levelcnv: GRIB2 Levels ',ltype1,ltype2, - & ' not recognized.' - ltype=255 - endif - -! High resolution stuff -! elseif (ltype.eq.121) then -! ipdstmpl(10)=100 -! ipdstmpl(12)=(1100+(lval/256))*100 -! ipdstmpl(13)=100 -! ipdstmpl(15)=(1100+mod(lval,256))*100 -! elseif (ltype.eq.125) then -! ipdstmpl(10)=103 -! ipdstmpl(11)=-2 -! ipdstmpl(12)=lval -! elseif (ltype.eq.128) then -! ipdstmpl(10)=104 -! ipdstmpl(11)=-3 -! ipdstmpl(12)=1100+(lval/256) -! ipdstmpl(13)=104 -! ipdstmpl(14)=-3 -! ipdstmpl(15)=1100+mod(lval,256) -! elseif (ltype.eq.141) then -! ipdstmpl(10)=100 -! ipdstmpl(12)=(lval/256)*100 -! ipdstmpl(13)=100 -! ipdstmpl(15)=(1100+mod(lval,256))*100 - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makepdsens.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makepdsens.f deleted file mode 100755 index a3f79dd3f7..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/makepdsens.f +++ /dev/null @@ -1,182 +0,0 @@ - subroutine makepdsens(ipdsnum,ipdstmpl,kpds,kens,kprob, - & xprob,kclust,kmembr,iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: makepdsens -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12 -C -C ABSTRACT: This routine creates the GRIB1 NCEP Ensemble PDS -C extension information from appropriate information from a GRIB2 -C Product Definition Template. -C -C PROGRAM HISTORY LOG: -C 2003-06-12 Gilbert -C 2007-05-14 Boi Vuong -Corrected scale factor probabilities -C -C USAGE: CALL makepdsens(ipdsnum,ipdstmpl,kpds,kens,kprob, -C xprob,kclust,kmembr,iret) -C INPUT ARGUMENT LIST: -C ipdsnum - GRIB2 Product Definition Template Number -C ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum -C kpds() - GRIB1 PDS info as specified in W3FI63. -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C -C OUTPUT ARGUMENT LIST: -C kpds() - GRIB1 PDS info as specified in W3FI63. -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C kens() - Ensemble identification for PDS octets 41-45 -C kprob() - Ensemble probability info for PDS octets 46 & 47 -C xprob() - Ensemble probability info for PDS octets 48-55 -C kclust() - Ensemble cluster info for PDS octets 61-76 -C kmembr() - Ensemble membership info for PDS octest 77-86 -C iret - Error return value: -C 0 = Successful -C 2 = Unrecognized GRIB2 PDT 4.ipdsnum -C -C REMARKS: Use pds2pdtens for ensemble related PDS -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use params - - integer,intent(in) :: ipdstmpl(*) - integer,intent(in) :: ipdsnum - integer,intent(inout) :: kpds(*) - integer,intent(out) :: kens(5),kprob(2) - integer,intent(out) :: kclust(16),kmembr(80) - real,intent(out) :: xprob(2) - integer,intent(out) :: iret - - iret=0 - kpds(23)=2 ! subcenter = ensemble - - kens(1:5)=0 - kprob(1:2)=0 - xprob(1:2)=0. - kclust(1:16)=0 - kmembr(1:80)=0 - ! - ! Individual Ensemble Fcst - ! - if ( ipdsnum.eq.1.OR.ipdsnum.eq.11 ) then - kens(1)=1 - selectcase ( ipdstmpl(16) ) - case(0) - kens(2)=1 - kens(3)=1 - case(1) - kens(2)=1 - kens(3)=2 - case(2) - kens(2)=2 - kens(3)=ipdstmpl(17) - case(3) - kens(2)=3 - kens(3)=ipdstmpl(17) - end select - kens(4)=1 - kens(5)=255 - - ! - ! Probability Fcst - ! - elseif ( ipdsnum.eq.5.OR.ipdsnum.eq.9 ) then - kens(1)=1 - kens(2)=5 - kens(3)=0 - kens(4)=0 - kens(5)=255 - kprob(1)=kpds(5) - kpds(5)=191 - kprob(2)=ipdstmpl(18)+1 - if ( kprob(2).eq.1 ) then - rscale=10.**ipdstmpl(19) - xprob(1)=real(ipdstmpl(20))/rscale - xprob(2)=0.0 - elseif ( kprob(2).eq.2 ) then - xprob(1)=0.0 - rscale=10.**ipdstmpl(21) - xprob(2)=real(ipdstmpl(22))/rscale - elseif ( kprob(2).eq.3 ) then - rscale=10.**ipdstmpl(19) - xprob(1)=real(ipdstmpl(20))/rscale - rscale=10.**ipdstmpl(21) - xprob(2)=real(ipdstmpl(22))/rscale - endif - kclust(1)=ipdstmpl(17) - ! - ! Derived Ensemble Fcst - ! - elseif ( ipdsnum.eq.2.OR.ipdsnum.eq.12 ) then - kens(1)=1 - kens(2)=5 - kens(3)=0 - selectcase ( ipdstmpl(16) ) - case(0) - kens(4)=1 - case(1) - kens(4)=2 - case(2) - kens(4)=11 - case(3) - kens(4)=12 - end select - !kens(5)=89 - kens(5)=0 - kclust(1)=ipdstmpl(17) - else - print *,'makepdsens: Don:t know GRIB2 PDT 4.',ipdsnum - iret=2 - endif - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/pds2pdt.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/pds2pdt.f deleted file mode 100755 index 0b091565e5..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/pds2pdt.f +++ /dev/null @@ -1,385 +0,0 @@ - subroutine pds2pdt(kpds,ipdsnum,ipdstmpl,numcoord,coordlist, - & iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: pds2pdt -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12 -C -C ABSTRACT: This routine converts a GRIB1 PDS (Section 1) info -C to a GRIB2 PDS (Section 4) info with appropriate Product Definition -C Template. -C -C PROGRAM HISTORY LOG: -C 2003-06-12 Gilbert -C 2005-04-19 Gilbert - Changed scaling factor used with potential -C vorticity surfaces. -C 2007-02-07 Gilbert - fixed end date calculation -C 2007-03-26 Gordon - Added check for ECMWF data to reference ECMWF -C Conversion tables. -C 2007-05-14 Boi Vuong - Added Time Range Indicator 51 (Climatological -C Mean Value) -C -C USAGE: CALL pds2pdt(kpds,ipdsnum,ipdstmpl,numcoord,coordlist,iret) -C INPUT ARGUMENT LIST: -C kpds() - GRIB1 PDS info as specified in W3FI63. -C -C OUTPUT ARGUMENT LIST: -C ipdsnum - GRIB2 Product Definition Template Number -C ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum -C numcoord - number of vertical discretisation values ( not implemented ) -C coordlist()- vertical discretisation values ( not implemented ) -C iret - Error return value: -C 0 = Successful -C 1 = Unrecognized GRIB1 Time Range Indicator -C -C REMARKS: Use pds2pdtens for ensemble related PDS -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use params - use params_ecmwf - - integer,intent(in) :: kpds(*) - integer,intent(out) :: ipdstmpl(*) - real,intent(out) :: coordlist(*) - integer,intent(out) :: ipdsnum,numcoord,iret - - integer :: idat(8),jdat(8) - real :: rinc(5) - logical :: ecmwf - - iret=0 - numcoord=0 - ecmwf=.false. - if (kpds(1).eq.98) ecmwf=.true. - if (kpds(16).eq.0.or.kpds(16).eq.1.or.kpds(16).eq.10) then - ipdsnum=0 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - if (ecmwf) then ! treat ecmwf data conversion seperately - call param_ecmwf_g1_to_g2(kpds(5),kpds(19),idum, - & ipdstmpl(1),ipdstmpl(2)) - else - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - endif - if (kpds(16).eq.1) then - ipdstmpl(3)=0 - else - ipdstmpl(3)=2 - endif - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - !if (kpds(16).eq.10) then - ! ipdstmpl(9)=(kpds(14)*256)+kpds(15) - !else - ipdstmpl(9)=kpds(14) - !endif - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - elseif (kpds(16).ge.2.AND.kpds(16).le.5) then - ipdsnum=8 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - if (ecmwf) then ! treat ecmwf data conversion seperately - call param_ecmwf_g1_to_g2(kpds(5),kpds(19),idum, - & ipdstmpl(1),ipdstmpl(2)) - else - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - endif - ipdstmpl(3)=2 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0.0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(16)=jdat(1) ! year of end time - ipdstmpl(17)=jdat(2) ! month of end time - ipdstmpl(18)=jdat(3) ! day of end time - ipdstmpl(19)=jdat(5) ! hour of end time - ipdstmpl(20)=jdat(6) ! minute of end time - ipdstmpl(21)=jdat(7) ! second of end time - ipdstmpl(22)=1 ! # of time ranges - ipdstmpl(23)=kpds(20) ! # of values missing - if (kpds(16).eq.2) then ! statistical process - ipdstmpl(24)=255 - elseif (kpds(16).eq.3) then - ipdstmpl(24)=0 - elseif (kpds(16).eq.4) then - ipdstmpl(24)=1 - elseif (kpds(16).eq.5) then - ipdstmpl(24)=4 - endif - ipdstmpl(25)=2 - ipdstmpl(26)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(26)=13 - ipdstmpl(27)=kpds(15)-kpds(14) - ipdstmpl(28)=255 - ipdstmpl(29)=0 - elseif (kpds(16).eq.51) then - ipdsnum=8 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - if (ecmwf) then ! treat ecmwf data conversion seperately - call param_ecmwf_g1_to_g2(kpds(5),kpds(19),idum, - & ipdstmpl(1),ipdstmpl(2)) - else - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - endif - ipdstmpl(3)=2 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0.0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(16)=jdat(1) ! year of end time - ipdstmpl(17)=jdat(2) ! month of end time - ipdstmpl(18)=jdat(3) ! day of end time - ipdstmpl(19)=jdat(5) ! hour of end time - ipdstmpl(20)=jdat(6) ! minute of end time - ipdstmpl(21)=jdat(7) ! second of end time - ipdstmpl(22)=1 ! # of time ranges - ipdstmpl(23)=kpds(20) ! # of values missing - ipdstmpl(24)=51 ! Climatological Mean - ipdstmpl(25)=2 - ipdstmpl(26)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(26)=13 - ipdstmpl(27)=kpds(15)-kpds(14) - ipdstmpl(28)=255 - ipdstmpl(29)=0 - else - Print *,' Unrecognized Time Range Indicator = ',kpds(16) - Print *,'pds2pdt: Couldn:t construct PDS Template ' - iret=1 - endif - - return - end - - - subroutine cnvlevel(ltype,lval,ipdstmpl) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: cnvlevel -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12 -C -C ABSTRACT: this routine converts a GRIB1 Level type and Level value -C to GRIB2 values and fills in the appropriate PDT values for the -C level/layer information. -C -C PROGRAM HISTORY LOG: -C 2003-06-12 Gilbert -C -C USAGE: CALL cnvlevel(ltype,lval,ipdstmpl) -C INPUT ARGUMENT LIST: -C ltype - GRIB1 level type (PDS octet 10) -C lval - GRIB1 level/layer value(s) (PDS octets 11 and 12) -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C ipdstmpl() - GRIB2 Product Definition Template values -C -C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - integer,intent(in) :: ltype,lval - integer,intent(inout) :: ipdstmpl(*) - - ipdstmpl(10)=ltype - ipdstmpl(11)=0 - ipdstmpl(12)=0 - ipdstmpl(13)=255 - ipdstmpl(14)=0 - ipdstmpl(15)=0 - - if (ltype.eq.100) then - ipdstmpl(12)=lval*100 - elseif (ltype.eq.101) then - ipdstmpl(10)=100 - ipdstmpl(12)=(lval/256)*1000 - ipdstmpl(13)=100 - ipdstmpl(15)=mod(lval,256)*1000 - elseif (ltype.eq.102) then - ipdstmpl(10)=101 - elseif (ltype.eq.103) then - ipdstmpl(10)=102 - ipdstmpl(12)=lval - elseif (ltype.eq.104) then - ipdstmpl(10)=102 - ipdstmpl(12)=lval/256 - ipdstmpl(13)=102 - ipdstmpl(15)=mod(lval,256) - elseif (ltype.eq.105) then - ipdstmpl(10)=103 - ipdstmpl(12)=lval - elseif (ltype.eq.106) then - ipdstmpl(10)=103 - ipdstmpl(12)=(lval/256)*100 - ipdstmpl(13)=103 - ipdstmpl(15)=mod(lval,256)*100 - elseif (ltype.eq.107) then - ipdstmpl(10)=104 - ipdstmpl(11)=4 - ipdstmpl(12)=lval - elseif (ltype.eq.108) then - ipdstmpl(10)=104 - ipdstmpl(11)=2 - ipdstmpl(12)=lval/256 - ipdstmpl(13)=104 - ipdstmpl(14)=2 - ipdstmpl(15)=mod(lval,256) - elseif (ltype.eq.109) then - ipdstmpl(10)=105 - ipdstmpl(12)=lval - elseif (ltype.eq.110) then - ipdstmpl(10)=105 - ipdstmpl(12)=lval/256 - ipdstmpl(13)=105 - ipdstmpl(15)=mod(lval,256) - elseif (ltype.eq.111) then - ipdstmpl(10)=106 - ipdstmpl(11)=2 - ipdstmpl(12)=lval - elseif (ltype.eq.112) then - ipdstmpl(10)=106 - ipdstmpl(11)=2 - ipdstmpl(12)=lval/256 - ipdstmpl(13)=106 - ipdstmpl(14)=2 - ipdstmpl(15)=mod(lval,256) - elseif (ltype.eq.113) then - ipdstmpl(10)=107 - ipdstmpl(12)=lval - elseif (ltype.eq.114) then - ipdstmpl(10)=107 - ipdstmpl(12)=475+(lval/256) - ipdstmpl(13)=107 - ipdstmpl(15)=475+mod(lval,256) - elseif (ltype.eq.115) then - ipdstmpl(10)=108 - ipdstmpl(12)=lval*100 - elseif (ltype.eq.116) then - ipdstmpl(10)=108 - ipdstmpl(12)=(lval/256)*100 - ipdstmpl(13)=108 - ipdstmpl(15)=mod(lval,256)*100 - elseif (ltype.eq.117) then - ipdstmpl(10)=109 - ipdstmpl(11)=9 - ipdstmpl(12)=lval - if ( btest(lval,15) ) then - ipdstmpl(12)=-1*mod(lval,32768) - endif - elseif (ltype.eq.119) then - ipdstmpl(10)=111 - ipdstmpl(11)=4 - ipdstmpl(12)=lval - elseif (ltype.eq.120) then - ipdstmpl(10)=111 - ipdstmpl(11)=2 - ipdstmpl(12)=lval/256 - ipdstmpl(13)=111 - ipdstmpl(14)=2 - ipdstmpl(15)=mod(lval,256) - elseif (ltype.eq.121) then - ipdstmpl(10)=100 - ipdstmpl(12)=(1100+(lval/256))*100 - ipdstmpl(13)=100 - ipdstmpl(15)=(1100+mod(lval,256))*100 - elseif (ltype.eq.125) then - ipdstmpl(10)=103 - ipdstmpl(11)=2 - ipdstmpl(12)=lval - elseif (ltype.eq.128) then - ipdstmpl(10)=104 - ipdstmpl(11)=3 - ipdstmpl(12)=1100+(lval/256) - ipdstmpl(13)=104 - ipdstmpl(14)=3 - ipdstmpl(15)=1100+mod(lval,256) - elseif (ltype.eq.141) then - ipdstmpl(10)=100 - ipdstmpl(12)=(lval/256)*100 - ipdstmpl(13)=100 - ipdstmpl(15)=(1100+mod(lval,256))*100 - elseif (ltype.eq.160) then - ipdstmpl(10)=160 - ipdstmpl(12)=lval - elseif (ltype.gt.99.AND.ltype.lt.200) then - print *,'cnvlevel: GRIB1 Level ',ltype,' not recognized.' - ipdstmpl(10)=255 - endif - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/pds2pdtens.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/pds2pdtens.f deleted file mode 100755 index 4e3af4fdc1..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/pds2pdtens.f +++ /dev/null @@ -1,649 +0,0 @@ - subroutine pds2pdtens(kpds,kens,kprob,xprob,kclust,kmember, - & ipdsnum,ipdstmpl,numcoord,coordlist, - & iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: pds2pdtens -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12 -C -C ABSTRACT: This routine converts a GRIB1 PDS (Section 1) that includes -C NCEP ensemble PDS extensions -C to a GRIB2 PDS (Section 4) info with appropriate Product Definition -C Template. -C -C PROGRAM HISTORY LOG: -C 2003-06-12 Gilbert -C 2007-02-07 Gilbert - fixed end date calculation -C 2007-05-14 Boi Vuong - Added Time Range Indicator 51 (Climatological -C Mean Value) -C -C USAGE: CALL pds2pdtens(kpds,kens,kprob,xprob,kclust,kmember, -C ipdsnum,ipdstmpl,numcoord,coordlist,iret) -C INPUT ARGUMENT LIST: -C kpds() - GRIB1 PDS info as specified in W3FI63. -C kens() - Ensemble identification from PDS octets 41-45 -C kprob() - Ensemble probability info from PDS octets 46 & 47 -C xprob() - Ensemble probability info from PDS octets 48-55 -C kclust() - Ensemble cluster info from PDS octets 61-76 -C kmember()- Ensemble membership info from PDS octest 77-86 -C -C OUTPUT ARGUMENT LIST: -C ipdsnum - GRIB2 Product Definition Template Number -C ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum -C numcoord - number of vertical discretisation values ( not implemented ) -C coordlist()- vertical discretisation values ( not implemented ) -C iret - Error return value: -C 0 = Successful -C 1 = Unrecognized GRIB1 Time Range Indicator for ensembles -C 2 = Unrecognized GRIB1 Ensemble type -C 10 = Unrecognized GRIB1 Time Range Indicator for probabilities -C -C REMARKS: Use routine pds2pdt for non ensemble related PDS. -C -C ATTRIBUTES: -C LANGUAGE: Fortran 90 -C MACHINE: IBM SP -C -C$$$ - - use params - - integer,intent(in) :: kpds(*),kens(*),kprob(*),kclust(*) - integer,intent(in) :: kmember(*) - real,intent(in) :: xprob(*) - integer,intent(out) :: ipdstmpl(*) - real,intent(out) :: coordlist(*) - integer,intent(out) :: ipdsnum,numcoord,iret - - integer :: idat(8),jdat(8) - real :: rinc(5) - - iret=0 - numcoord=0 - if (kens(2).eq.1.or.kens(2).eq.2.or.kens(2).eq.3) then - ! individual ensemble fcst... - if (kpds(16).eq.0.or.kpds(16).eq.1.or.kpds(16).eq.10) then - ! At specific point in time... - ipdsnum=1 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=4 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - !if (kpds(16).eq.10) then - ! ipdstmpl(9)=(kpds(14)*256)+kpds(15) - !else - ipdstmpl(9)=kpds(14) - !endif - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - if (kens(2).eq.1) then -! if (kens(3).eq.1) ipdstmpl(16)=0 -! if (kens(3).eq.2) ipdstmpl(16)=1 - ipdstmpl(16)=kens(3)-1 - ipdstmpl(17)=0 - elseif (kens(2).eq.2) then - ipdstmpl(16)=2 - ipdstmpl(17)=kens(3) - elseif (kens(2).eq.3) then - ipdstmpl(16)=3 - ipdstmpl(17)=kens(3) - endif - ipdstmpl(18)=10 - elseif (kpds(16).ge.2.AND.kpds(16).le.5) then - ! over time range... - ipdsnum=11 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=4 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - !ipdstmpl(9)=kpds(15) - if (kens(2).eq.1) then -! if (kens(3).eq.1) ipdstmpl(16)=0 -! if (kens(3).eq.2) ipdstmpl(16)=1 - ipdstmpl(16)=kens(3)-1 - ipdstmpl(17)=0 - elseif (kens(2).eq.2) then - ipdstmpl(16)=2 - ipdstmpl(17)=kens(3) - elseif (kens(2).eq.3) then - ipdstmpl(16)=3 - ipdstmpl(17)=kens(3) - endif - ipdstmpl(18)=10 - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(19)=jdat(1) ! year of end time - ipdstmpl(20)=jdat(2) ! month of end time - ipdstmpl(21)=jdat(3) ! day of end time - ipdstmpl(22)=jdat(5) ! hour of end time - ipdstmpl(23)=jdat(6) ! minute of end time - ipdstmpl(24)=jdat(7) ! second of end time - ipdstmpl(25)=1 - ipdstmpl(26)=0 - if (kpds(16).eq.2) then - ipdstmpl(27)=255 - if (kpds(5).eq.15) ipdstmpl(27)=2 - if (kpds(5).eq.16) ipdstmpl(27)=3 - elseif (kpds(16).eq.3) then - ipdstmpl(27)=0 - elseif (kpds(16).eq.4) then - ipdstmpl(27)=1 - elseif (kpds(16).eq.5) then - ipdstmpl(27)=4 - endif - ipdstmpl(28)=2 - ipdstmpl(29)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(29)=13 - ipdstmpl(30)=kpds(15)-kpds(14) - ipdstmpl(31)=255 - ipdstmpl(32)=0 - elseif (kpds(16).eq.51) then - ! over time range... - ipdsnum=11 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=4 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - !ipdstmpl(9)=kpds(15) - if (kens(2).eq.1) then -! if (kens(3).eq.1) ipdstmpl(16)=0 -! if (kens(3).eq.2) ipdstmpl(16)=1 - ipdstmpl(16)=kens(3)-1 - ipdstmpl(17)=0 - elseif (kens(2).eq.2) then - ipdstmpl(16)=2 - ipdstmpl(17)=kens(3) - elseif (kens(2).eq.3) then - ipdstmpl(16)=3 - ipdstmpl(17)=kens(3) - endif - ipdstmpl(18)=10 - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(19)=jdat(1) ! year of end time - ipdstmpl(20)=jdat(2) ! month of end time - ipdstmpl(21)=jdat(3) ! day of end time - ipdstmpl(22)=jdat(5) ! hour of end time - ipdstmpl(23)=jdat(6) ! minute of end time - ipdstmpl(24)=jdat(7) ! second of end time - ipdstmpl(25)=1 - ipdstmpl(26)=0 - ipdstmpl(27)=51 - ipdstmpl(28)=2 - ipdstmpl(29)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(29)=13 - ipdstmpl(30)=kpds(15)-kpds(14) - ipdstmpl(31)=255 - ipdstmpl(32)=0 - else - Print *,' Unrecognized Time Range Ind for ensembles = ', - & kpds(16),kens(2) - Print *,'pds2pdtens: Couldn:t construct PDS Template ' - iret=1 - endif - - elseif (kens(2).eq.5) then ! WHOLE or CLUSTERENSEMBLE type - if (kpds(5).eq.191.OR.kpds(5).eq.192) then ! probs - if (kpds(16).eq.0.or.kpds(16).eq.1.or.kpds(16).eq.10) then - ! At specific point in time... - ipdsnum=5 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kprob(1),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=5 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - !if (kpds(16).eq.10) then - ! ipdstmpl(9)=(kpds(14)*256)+kpds(15) - !else - ipdstmpl(9)=kpds(14) - !endif - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - ipdstmpl(16)=0 !? - ipdstmpl(17)=kclust(1) !? - ipdstmpl(18)=kprob(2)-1 - if (ipdstmpl(18).eq.0.OR.ipdstmpl(18).eq.2) then - ipdstmpl(19)=3 - ipdstmpl(20)=nint(xprob(1)*1000.0) - else - ipdstmpl(19)=0 - ipdstmpl(20)=0 - endif - if (ipdstmpl(18).eq.1.OR.ipdstmpl(18).eq.2) then - ipdstmpl(21)=3 - ipdstmpl(22)=nint(xprob(2)*1000.0) - else - ipdstmpl(21)=0 - ipdstmpl(22)=0 - endif - elseif (kpds(16).ge.2.AND.kpds(16).le.5) then - ! over time range... - ipdsnum=9 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kprob(1),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=5 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - !ipdstmpl(9)=kpds(15) - ipdstmpl(16)=0 !? - ipdstmpl(17)=kclust(1) !? - ipdstmpl(18)=kprob(2)-1 - if (ipdstmpl(18).eq.0.OR.ipdstmpl(18).eq.2) then - ipdstmpl(19)=3 - ipdstmpl(20)=nint(xprob(1)*1000.0) - else - ipdstmpl(19)=0 - ipdstmpl(20)=0 - endif - if (ipdstmpl(18).eq.1.OR.ipdstmpl(18).eq.2) then - ipdstmpl(21)=3 - ipdstmpl(22)=nint(xprob(2)*1000.0) - else - ipdstmpl(21)=0 - ipdstmpl(22)=0 - endif - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(23)=jdat(1) ! year of end time - ipdstmpl(24)=jdat(2) ! month of end time - ipdstmpl(25)=jdat(3) ! day of end time - ipdstmpl(26)=jdat(5) ! hour of end time - ipdstmpl(27)=jdat(6) ! minute of end time - ipdstmpl(28)=jdat(7) ! second of end time - ipdstmpl(29)=1 - ipdstmpl(30)=0 - if (kpds(16).eq.2) then - ipdstmpl(31)=255 - if (kpds(5).eq.15) ipdstmpl(31)=2 - if (kpds(5).eq.16) ipdstmpl(31)=3 - elseif (kpds(16).eq.3) then - ipdstmpl(31)=0 - elseif (kpds(16).eq.4) then - ipdstmpl(31)=1 - elseif (kpds(16).eq.5) then - ipdstmpl(31)=4 - endif - ipdstmpl(32)=2 - ipdstmpl(33)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(33)=13 - ipdstmpl(34)=kpds(15)-kpds(14) - ipdstmpl(35)=255 - ipdstmpl(36)=0 - elseif (kpds(16).eq.51) then - ! over time range... - ipdsnum=9 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kprob(1),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=5 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - !ipdstmpl(9)=kpds(15) - ipdstmpl(16)=0 !? - ipdstmpl(17)=kclust(1) !? - ipdstmpl(18)=kprob(2)-1 - if (ipdstmpl(18).eq.0.OR.ipdstmpl(18).eq.2) then - ipdstmpl(19)=3 - ipdstmpl(20)=nint(xprob(1)*1000.0) - else - ipdstmpl(19)=0 - ipdstmpl(20)=0 - endif - if (ipdstmpl(18).eq.1.OR.ipdstmpl(18).eq.2) then - ipdstmpl(21)=3 - ipdstmpl(22)=nint(xprob(2)*1000.0) - else - ipdstmpl(21)=0 - ipdstmpl(22)=0 - endif - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(23)=jdat(1) ! year of end time - ipdstmpl(24)=jdat(2) ! month of end time - ipdstmpl(25)=jdat(3) ! day of end time - ipdstmpl(26)=jdat(5) ! hour of end time - ipdstmpl(27)=jdat(6) ! minute of end time - ipdstmpl(28)=jdat(7) ! second of end time - ipdstmpl(29)=1 - ipdstmpl(30)=0 - ipdstmpl(31)=51 - ipdstmpl(32)=2 - ipdstmpl(33)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(33)=13 - ipdstmpl(34)=kpds(15)-kpds(14) - ipdstmpl(35)=255 - ipdstmpl(36)=0 - else - Print *,' Unrecognized Time Range Ind for Probs = ', - & kpds(16),kens(2) - Print *,'pds2pdtens: Couldn:t construct PDS Template ' - iret=10 - endif - else ! Non-probablility Whole Ens Fcst - if (kpds(16).eq.0.or.kpds(16).eq.1.or.kpds(16).eq.10) then - ! At specific point in time... - ipdsnum=2 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=4 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - !if (kpds(16).eq.10) then - ! ipdstmpl(9)=(kpds(14)*256)+kpds(15) - !else - ipdstmpl(9)=kpds(14) - !endif - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - if (kens(4).eq.1) then - ipdstmpl(16)=0 - elseif (kens(4).eq.2) then - ipdstmpl(16)=1 - elseif (kens(4).eq.11) then - ipdstmpl(16)=2 - elseif (kens(4).eq.12) then - ipdstmpl(16)=3 - endif - ipdstmpl(17)=kclust(1) - elseif (kpds(16).ge.2.AND.kpds(16).le.5) then - ! over time range... - ipdsnum=12 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=4 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - !ipdstmpl(9)=kpds(15) - if (kens(4).eq.1) then - ipdstmpl(16)=0 - elseif (kens(4).eq.2) then - ipdstmpl(16)=1 - elseif (kens(4).eq.11) then - ipdstmpl(16)=2 - elseif (kens(4).eq.12) then - ipdstmpl(16)=3 - endif - ipdstmpl(17)=kclust(1) - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(18)=jdat(1) ! year of end time - ipdstmpl(19)=jdat(2) ! month of end time - ipdstmpl(20)=jdat(3) ! day of end time - ipdstmpl(21)=jdat(5) ! hour of end time - ipdstmpl(22)=jdat(6) ! minute of end time - ipdstmpl(23)=jdat(7) ! second of end time - ipdstmpl(24)=1 - ipdstmpl(25)=0 - if (kpds(16).eq.2) then - ipdstmpl(26)=255 - if (kpds(5).eq.15) ipdstmpl(26)=2 - if (kpds(5).eq.16) ipdstmpl(26)=3 - elseif (kpds(16).eq.3) then - ipdstmpl(26)=0 - elseif (kpds(16).eq.4) then - ipdstmpl(26)=1 - elseif (kpds(16).eq.5) then - ipdstmpl(26)=4 - endif - ipdstmpl(27)=2 - ipdstmpl(28)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(28)=13 - ipdstmpl(29)=kpds(15)-kpds(14) - ipdstmpl(30)=255 - ipdstmpl(31)=0 - elseif (kpds(16).eq.51) then - ! over time range... - ipdsnum=12 - ! get GRIB2 parameter category and number from GRIB1 - ! parameter number - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmpl(1), - & ipdstmpl(2)) - ipdstmpl(3)=4 - ipdstmpl(4)=0 - ipdstmpl(5)=kpds(2) - ipdstmpl(6)=0 - ipdstmpl(7)=0 - ipdstmpl(8)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(8)=13 - ipdstmpl(9)=kpds(14) - call cnvlevel(kpds(6),kpds(7),ipdstmpl) - !ipdstmpl(9)=kpds(15) - if (kens(4).eq.1) then - ipdstmpl(16)=0 - elseif (kens(4).eq.2) then - ipdstmpl(16)=1 - elseif (kens(4).eq.11) then - ipdstmpl(16)=2 - elseif (kens(4).eq.12) then - ipdstmpl(16)=3 - endif - ipdstmpl(17)=kclust(1) - ! calculate ending time using initial ref-time, idat, - ! and increment rinc. - idat=0 - idat(1)=((kpds(21)-1)*100)+kpds(8) - idat(2)=kpds(9) - idat(3)=kpds(10) - idat(4)=-500 ! EST - idat(5)=kpds(11) - idat(6)=kpds(12) - rinc=0 - if ( ipdstmpl(8).eq.0 ) then - rinc(3)=kpds(15) - elseif ( ipdstmpl(8).eq.1 ) then - rinc(2)=kpds(15) - elseif ( ipdstmpl(8).eq.2 ) then - rinc(1)=kpds(15) - elseif ( ipdstmpl(8).eq.10 ) then - rinc(2)=kpds(15) * 3 - elseif ( ipdstmpl(8).eq.11 ) then - rinc(2)=kpds(15) * 6 - elseif ( ipdstmpl(8).eq.12 ) then - rinc(2)=kpds(15) * 12 - elseif ( ipdstmpl(8).eq.13 ) then - rinc(4)=kpds(15) - endif - call w3movdat(rinc,idat,jdat) ! calculate end date/time - ipdstmpl(18)=jdat(1) ! year of end time - ipdstmpl(19)=jdat(2) ! month of end time - ipdstmpl(20)=jdat(3) ! day of end time - ipdstmpl(21)=jdat(5) ! hour of end time - ipdstmpl(22)=jdat(6) ! minute of end time - ipdstmpl(23)=jdat(7) ! second of end time - ipdstmpl(24)=1 - ipdstmpl(25)=0 - ipdstmpl(26)=51 - ipdstmpl(27)=2 - ipdstmpl(28)=kpds(13) - if (kpds(13).eq.254) ipdstmpl(28)=13 - ipdstmpl(29)=kpds(15)-kpds(14) - ipdstmpl(30)=255 - ipdstmpl(31)=0 - endif - endif - else - Print *,' Unrecognized Ensemble type = ',kens(2) - Print *,'pds2pdtens: Couldn:t construct PDS Template ' - iret=2 - endif - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/putgbexn.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/putgbexn.f deleted file mode 100755 index f07f0b1fbc..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/putgbexn.f +++ /dev/null @@ -1,249 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGBEXN(LUGB,KF,KPDS,KGDS,KENS, - & KPROB,XPROB,KCLUST,KMEMBR,IBS,NBITS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGBEXN PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGBE. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 97-02-11 Y.ZHU INCLUDED PROBABILITY AND CLUSTER ARGUMENTS -C 2002-03-18 GILBERT MODIFIED FROM PUTGBEX TO ACCOUNT FOR -C BINARY SCALE FACTORS. -C -C USAGE: CALL PUTGBEXN(LUGB,KF,KPDS,KGDS,KENS, -C & KPROB,XPROB,KCLUST,KMEMBR,IBS,NBITS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C KENS INTEGER (200) ENSEMBLE PDS PARMS -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C KPROB INTEGER (2) PROBABILITY ENSEMBLE PARMS -C XPROB REAL (2) PROBABILITY ENSEMBLE PARMS -C KCLUST INTEGER (16) CLUSTER ENSEMBLE PARMS -C KMEMBR INTEGER (8) CLUSTER ENSEMBLE PARMS -C IBS INTEGER BINARY SCALE FACTOR (0 TO IGNORE) -C NBITS INTEGER NUMBER OF BITS IN WHICH TO PACK (0 TO IGNORE) -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - INTEGER KPROB(2),KCLUST(16),KMEMBR(80) - REAL XPROB(2) - LOGICAL*1 LB(KF) - REAL F(KF) -C PARAMETER(MAXBIT=16) - PARAMETER(MAXBIT=24) - INTEGER IBM(KF),IPDS(200),IGDS(200),IBDS(200) - CHARACTER PDS(400),GRIB(1000+KF*(MAXBIT+1)/8) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET W3FI72 PARAMETERS - !print *,'SAGT: start putgbexn' - CALL R63W72(KPDS,KGDS,IPDS,IGDS) - IBDS=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COUNT VALID DATA - KBM=KF - IF(IPDS(7).NE.0) THEN - KBM=0 - DO I=1,KF - IF(LB(I)) THEN - IBM(I)=1 - KBM=KBM+1 - ELSE - IBM(I)=0 - ENDIF - ENDDO - IF(KBM.EQ.KF) IPDS(7)=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET NUMBER OF BITS AND ROUND DATA - IF(NBITS.GT.0) THEN - NBIT=NBITS - ELSE - IF(KBM.EQ.0) THEN - DO I=1,KF - F(I)=0. - ENDDO - NBIT=0 - ELSE - !print *,'SAGT:',IPDS(7),IBS,IPDS(25),KF - !print *,'SAGT:',count(ibm.eq.0),count(ibm.eq.1) - CALL SETBIT(IPDS(7),-IBS,IPDS(25),KF,IBM,F,FMIN,FMAX,NBIT) - NBIT=MIN(NBIT,MAXBIT) - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CREATE PRODUCT DEFINITION SECTION - CALL W3FI68(IPDS,PDS) - IF(IPDS(24).EQ.2) THEN - ILAST=45 - IF ( IPDS(8).EQ.191.OR.IPDS(8).EQ.192 ) ILAST=55 - IF ( KENS(2).EQ.5) ILAST=76 - IF ( KENS(2).EQ.5) ILAST=86 - IF ( KENS(2).EQ.4) ILAST=86 - CALL PDSENS(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,PDS) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PACK AND WRITE GRIB DATA - igflag=1 - igrid=kpds(3) - if ( igrid.ne.255 ) igflag=0 - !print *,minval(f(1:kf)),maxval(f(1:kf)) - !print *,nbit,kf - !print *,(ipds(j),j=1,28) - !write(6,fmt='(28z2)') (pds(j),j=1,28) - !print *,(kgds(j),j=1,28) - !print *,(igds(j),j=1,28) - icomp=0 - CALL W3FI72(0,F,0,NBIT,1,IPDS,PDS, - & igflag,igrid,IGDS,ICOMP,0,IBM,KF,IBDS, - & KFO,GRIB,LGRIB,IRET) - IF(IRET.EQ.0) CALL WRYTE(LUGB,LGRIB,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - - diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/setbit.f b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/setbit.f deleted file mode 100755 index 11976916d4..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/setbit.f +++ /dev/null @@ -1,80 +0,0 @@ - SUBROUTINE SETBIT(IBM,IBS,IDS,LEN,MG,G,GMIN,GMAX,NBIT) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: SETBIT COMPUTE NUMBER OF BITS TO PACK FIELD -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 92-10-31 -C -C ABSTRACT: THE NUMBER OF BITS REQUIRED TO PACK A GIVEN FIELD -C FOR PARTICULAR BINARY AND DECIMAL SCALINGS IS COMPUTED. -C THE MINIMUM AND MAXIMUM ROUNDED FIELD VALUES ARE ALSO RETURNED. -C GRIB BITMAP MASKING FOR VALID DATA IS OPTIONALLY USED. -C -C PROGRAM HISTORY LOG: -C 96-09-16 IREDELL -C -C USAGE: CALL SETBIT(IBM,IBS,IDS,LEN,MG,G,GMIN,GMAX,NBIT) -C INPUT ARGUMENT LIST: -C IBM - INTEGER BITMAP FLAG (=0 FOR NO BITMAP) -C IBS - INTEGER BINARY SCALING -C (E.G. IBS=3 TO ROUND FIELD TO NEAREST EIGHTH VALUE) -C IDS - INTEGER DECIMAL SCALING -C (E.G. IDS=3 TO ROUND FIELD TO NEAREST MILLI-VALUE) -C (NOTE THAT IDS AND IBS CAN BOTH BE NONZERO, -C E.G. IDS=1 AND IBS=1 ROUNDS TO THE NEAREST TWENTIETH) -C LEN - INTEGER LENGTH OF THE FIELD AND BITMAP -C MG - INTEGER (LEN) BITMAP IF IBM=1 (0 TO SKIP, 1 TO KEEP) -C G - REAL (LEN) FIELD -C -C OUTPUT ARGUMENT LIST: -C GMIN - REAL MINIMUM VALID ROUNDED FIELD VALUE -C GMAX - REAL MAXIMUM VALID ROUNDED FIELD VALUE -C NBIT - INTEGER NUMBER OF BITS TO PACK -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - DIMENSION MG(LEN),G(LEN) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C ROUND FIELD AND DETERMINE EXTREMES WHERE BITMAP IS ON - S=2.**IBS*10.**IDS - IF(IBM.EQ.0) THEN - GMAX=G(1) - GMIN=G(1) - DO I=2,LEN - GMAX=MAX(GMAX,G(I)) - GMIN=MIN(GMIN,G(I)) - ENDDO - ELSE - I1=1 - DOWHILE(I1.LE.LEN.AND.MG(I1).EQ.0) - I1=I1+1 - ENDDO - IF(I1.LE.LEN) THEN - DO I=1,I1-1 - G(I)=0. - ENDDO - GMAX=G(I1) - GMIN=G(I1) - DO I=I1+1,LEN - IF(MG(I).NE.0) THEN - GMAX=MAX(GMAX,G(I)) - GMIN=MIN(GMIN,G(I)) - ELSE - G(I)=0. - ENDIF - ENDDO - ELSE - DO I=1,LEN - G(I)=0. - ENDDO - GMAX=0. - GMIN=0. - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COMPUTE NUMBER OF BITS - NBIT=LOG((GMAX-GMIN)*S+0.9)/LOG(2.)+1. -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/so b/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/so deleted file mode 100644 index 5ec99517df..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/cnvgrib-1.1.8/so +++ /dev/null @@ -1,16 +0,0 @@ -CHANGES -cnv12.f -cnv21.f -cnv22.f -cnvgrib.f -gds2gdt.f -gdt2gds.f -grbCnv.so -makefile -makepdsens.f -makepds.f -pds2pdtens.f -pds2pdt.f -putgbexn.f -README -setbit.f diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/grib2.h b/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/grib2.h deleted file mode 100755 index 77f4d2e4e2..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/grib2.h +++ /dev/null @@ -1,249 +0,0 @@ -#ifndef _grib2_H -#define _grib2_H -#include - -#define G2_VERSION "g2clib-1.1.8" -/* . . . . -// PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-10-25 -// -// PROGRAM HISTORY LOG: -// 2002-10-25 Gilbert -// 2009-01-14 Vuong Changed struct template to gtemplate -// -// Each element of structure gribfield is defined as: -// -// gribfield gfld; -// -// gfld->version = GRIB edition number ( currently 2 ) -// gfld->discipline = Message Discipline ( see Code Table 0.0 ) -// gfld->idsect = Contains the entries in the Identification -// Section ( Section 1 ) -// This element is a pointer to an array -// that holds the data. -// gfld->idsect[0] = Identification of originating Centre -// ( see Common Code Table C-1 ) -// 7 - US National Weather Service -// gfld->idsect[1] = Identification of originating Sub-centre -// gfld->idsect[2] = GRIB Master Tables Version Number -// ( see Code Table 1.0 ) -// 0 - Experimental -// 1 - Initial operational version number -// gfld->idsect[3] = GRIB Local Tables Version Number -// ( see Code Table 1.1 ) -// 0 - Local tables not used -// 1-254 - Number of local tables version used -// gfld->idsect[4] = Significance of Reference Time (Code Table 1.2) -// 0 - Analysis -// 1 - Start of forecast -// 2 - Verifying time of forecast -// 3 - Observation time -// gfld->idsect[5] = Year ( 4 digits ) -// gfld->idsect[6] = Month -// gfld->idsect[7) = Day -// gfld->idsect[8] = Hour -// gfld->idsect[9] = Minute -// gfld->idsect[10] = Second -// gfld->idsect[11] = Production status of processed data -// ( see Code Table 1.3 ) -// 0 - Operational products -// 1 - Operational test products -// 2 - Research products -// 3 - Re-analysis products -// gfld->idsect[12] = Type of processed data ( see Code Table 1.4 ) -// 0 - Analysis products -// 1 - Forecast products -// 2 - Analysis and forecast products -// 3 - Control forecast products -// 4 - Perturbed forecast products -// 5 - Control and perturbed forecast products -// 6 - Processed satellite observations -// 7 - Processed radar observations -// gfld->idsectlen = Number of elements in gfld->idsect[]. -// gfld->local = Pointer to character array containing contents -// of Local Section 2, if included -// gfld->locallen = length of array gfld->local[] -// gfld->ifldnum = field number within GRIB message -// gfld->griddef = Source of grid definition (see Code Table 3.0) -// 0 - Specified in Code table 3.1 -// 1 - Predetermined grid Defined by originating centre -// gfld->ngrdpts = Number of grid points in the defined grid. -// gfld->numoct_opt = Number of octets needed for each -// additional grid points definition. -// Used to define number of -// points in each row ( or column ) for -// non-regular grids. -// = 0, if using regular grid. -// gfld->interp_opt = Interpretation of list for optional points -// definition. (Code Table 3.11) -// gfld->igdtnum = Grid Definition Template Number (Code Table 3.1) -// gfld->igdtmpl = Contains the data values for the specified Grid -// Definition Template ( NN=gfld->igdtnum ). Each -// element of this integer array contains an entry (in -// the order specified) of Grid Defintion Template 3.NN -// This element is a pointer to an array -// that holds the data. -// gfld->igdtlen = Number of elements in gfld->igdtmpl[]. i.e. number of -// entries in Grid Defintion Template 3.NN -// ( NN=gfld->igdtnum ). -// gfld->list_opt = (Used if gfld->numoct_opt .ne. 0) This array -// contains the number of grid points contained in -// each row ( or column ). (part of Section 3) -// This element is a pointer to an array -// that holds the data. This pointer is nullified -// if gfld->numoct_opt=0. -// gfld->num_opt = (Used if gfld->numoct_opt .ne. 0) The number of entries -// in array ideflist. i.e. number of rows ( or columns ) -// for which optional grid points are defined. This value -// is set to zero, if gfld->numoct_opt=0. -// gfdl->ipdtnum = Product Definition Template Number (see Code Table 4.0) -// gfld->ipdtmpl = Contains the data values for the specified Product -// Definition Template ( N=gfdl->ipdtnum ). Each element -// of this integer array contains an entry (in the -// order specified) of Product Defintion Template 4.N. -// This element is a pointer to an array -// that holds the data. -// gfld->ipdtlen = Number of elements in gfld->ipdtmpl[]. i.e. number of -// entries in Product Defintion Template 4.N -// ( N=gfdl->ipdtnum ). -// gfld->coord_list = Real array containing floating point values -// intended to document the vertical discretisation -// associated to model data on hybrid coordinate -// vertical levels. (part of Section 4) -// This element is a pointer to an array -// that holds the data. -// gfld->num_coord = number of values in array gfld->coord_list[]. -// gfld->ndpts = Number of data points unpacked and returned. -// gfld->idrtnum = Data Representation Template Number -// ( see Code Table 5.0) -// gfld->idrtmpl = Contains the data values for the specified Data -// Representation Template ( N=gfld->idrtnum ). Each -// element of this integer array contains an entry -// (in the order specified) of Product Defintion -// Template 5.N. -// This element is a pointer to an array -// that holds the data. -// gfld->idrtlen = Number of elements in gfld->idrtmpl[]. i.e. number -// of entries in Data Representation Template 5.N -// ( N=gfld->idrtnum ). -// gfld->unpacked = logical value indicating whether the bitmap and -// data values were unpacked. If false, -// gfld->bmap and gfld->fld pointers are nullified. -// gfld->expanded = Logical value indicating whether the data field -// was expanded to the grid in the case where a -// bit-map is present. If true, the data points in -// gfld->fld match the grid points and zeros were -// inserted at grid points where data was bit-mapped -// out. If false, the data values in gfld->fld were -// not expanded to the grid and are just a consecutive -// array of data points corresponding to each value of -// "1" in gfld->bmap. -// gfld->ibmap = Bitmap indicator ( see Code Table 6.0 ) -// 0 = bitmap applies and is included in Section 6. -// 1-253 = Predefined bitmap applies -// 254 = Previously defined bitmap applies to this field -// 255 = Bit map does not apply to this product. -// gfld->bmap = integer array containing decoded bitmap, -// if gfld->ibmap=0 or gfld->ibap=254. Otherwise nullified. -// This element is a pointer to an array -// that holds the data. -// gfld->fld = Array of gfld->ndpts unpacked data points. -// This element is a pointer to an array -// that holds the data. -*/ - -#ifdef __64BIT__ -typedef int g2int; -typedef unsigned int g2intu; -#else -typedef long g2int; -typedef unsigned long g2intu; -#endif -typedef float g2float; - -struct gtemplate { - g2int type; /* 3=Grid Defintion Template. */ - /* 4=Product Defintion Template. */ - /* 5=Data Representation Template. */ - g2int num; /* template number. */ - g2int maplen; /* number of entries in the static part */ - /* of the template. */ - g2int *map; /* num of octets of each entry in the */ - /* static part of the template. */ - g2int needext; /* indicates whether or not the template needs */ - /* to be extended. */ - g2int extlen; /* number of entries in the template extension. */ - g2int *ext; /* num of octets of each entry in the extension */ - /* part of the template. */ -}; - -typedef struct gtemplate gtemplate; - -struct gribfield { - g2int version,discipline; - g2int *idsect; - g2int idsectlen; - unsigned char *local; - g2int locallen; - g2int ifldnum; - g2int griddef,ngrdpts; - g2int numoct_opt,interp_opt,num_opt; - g2int *list_opt; - g2int igdtnum,igdtlen; - g2int *igdtmpl; - g2int ipdtnum,ipdtlen; - g2int *ipdtmpl; - g2int num_coord; - g2float *coord_list; - g2int ndpts,idrtnum,idrtlen; - g2int *idrtmpl; - g2int unpacked; - g2int expanded; - g2int ibmap; - g2int *bmap; - g2float *fld; -}; - -typedef struct gribfield gribfield; - - -/* Prototypes for unpacking API */ -void seekgb(FILE *,g2int ,g2int ,g2int *,g2int *); -g2int g2_info(unsigned char *,g2int *,g2int *,g2int *,g2int *); -g2int g2_getfld(unsigned char *,g2int ,g2int ,g2int ,gribfield **); -void g2_free(gribfield *); - -/* Prototypes for packing API */ -g2int g2_create(unsigned char *,g2int *,g2int *); -g2int g2_addlocal(unsigned char *,unsigned char *,g2int ); -g2int g2_addgrid(unsigned char *,g2int *,g2int *,g2int *,g2int ); -g2int g2_addfield(unsigned char *,g2int ,g2int *, - g2float *,g2int ,g2int ,g2int *, - g2float *,g2int ,g2int ,g2int *); -g2int g2_gribend(unsigned char *); - -/* Prototypes for supporting routines */ -extern double int_power(double, g2int ); -extern void mkieee(g2float *,g2int *,g2int); -void rdieee(g2int *,g2float *,g2int ); -extern gtemplate *getpdstemplate(g2int); -extern gtemplate *extpdstemplate(g2int,g2int *); -extern gtemplate *getdrstemplate(g2int); -extern gtemplate *extdrstemplate(g2int,g2int *); -extern gtemplate *getgridtemplate(g2int); -extern gtemplate *extgridtemplate(g2int,g2int *); -extern void simpack(g2float *,g2int,g2int *,unsigned char *,g2int *); -extern void compack(g2float *,g2int,g2int,g2int *,unsigned char *,g2int *); -void misspack(g2float *,g2int ,g2int ,g2int *, unsigned char *, g2int *); -void gbit(unsigned char *,g2int *,g2int ,g2int ); -void sbit(unsigned char *,g2int *,g2int ,g2int ); -void gbits(unsigned char *,g2int *,g2int ,g2int ,g2int ,g2int ); -void sbits(unsigned char *,g2int *,g2int ,g2int ,g2int ,g2int ); - -int pack_gp(g2int *, g2int *, g2int *, - g2int *, g2int *, g2int *, g2int *, g2int *, - g2int *, g2int *, g2int *, g2int *, - g2int *, g2int *, g2int *, g2int *, g2int *, - g2int *, g2int *, g2int *); - -#endif /* _grib2_H */ - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/CHANGES b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/CHANGES deleted file mode 100755 index cbb19aaec3..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/CHANGES +++ /dev/null @@ -1,89 +0,0 @@ - -g2lib-1.0 - August 2003 - Original version - -g2lib-1.0.1 - October 2003 - Added support for Grid Definition Template 3.31 - Albers Equal Area. - - Added new parameters to the Parameter list in - params.f - - Minor documentation updates. - -g2lib-1.0.2 - February 2004 - Added new parameters in params.f for use with - Quickscat data and Ozone (Air Quality) - -g2lib-1.0.3 - May 2004 - Changed most PDT templates in module pdstemplates to - allow negative surface values. - - Added new routine to gridtemplates and pdstemplates - modules to return number of entries in a specified - template. - - Added New routines, getgb2p getgb2rp, used to request - a packed GRIB2 message from a file. - - New module g2grids can be used to return GDT entries - for a specific grid from a file containing a list of - predefined grids. - -g2lib-1.0.4 - August 2004 - Added functionality to support encoding of - "Missing" data values within the data field when - using Data Representation Templates 5.2 - (complex packing) and 5.3 (complex packing and - spatial differencing). See octets 23 - 31 in DRTs - 5.2 and 5.3 for more info on missing value - management. - - Increased the packing efficiency of Data - Representation Templates 5.2 and 5.3 by adding - MDL/Glahn algorithm for determining effective - groupings. - -g2lib-1.0.5 - December 2004 - WMO approved the JPEG2000 and PNG Data - Representation Templates ( 5.40000 and 5.40010, - respectively ) for operational use. The templates - were assigned WMO values of 5.40 and 5.41, - respectively. Changes were made to the source to - recognize either template number. - - Fixed bug encountered when packing a near constant - field with DRT 5.40 or 5.40000 (JPEG2000). - - Added consistency check, provided by - Arthur Taylor/MDL, used when unpacking Data - Templates 7.2 and 7.3. - - Corrected the documentation for subroutine - addfield in the grib2.doc file. Incorrect - arguments were specified for this routine. - - Corrected bug when packing Secondary missing - values in Data Representation Templates 5.2 and - 5.3. - -g2lib-1.0.6 - April 2005 - Modified the way GETGB2 manages the GRIB2 file - indexes, so that it can be more efficient and - flexible when reading from multiple - GRIB2 files. - - Fixed bug in PUTGB2 that caused data fields to be - encoded incorrectly. - - Added routine gdt2gds that converts grid information - from a GRIB2 Grid Description Section (GDS) and - Grid Definition Template to GRIB1 GDS info. - -g2lib-1.0.7 - April 2005 - Fixed bug causing seg fault when using JPEG2000 - encoding algorithm on a grid with an insanely large - number of data points bitmapped out. - -g2lib-1.0.8 - October 2006 - Modified Product Definition Templates 4.5 and 4.9 - to allow negative scale factors and limits. - - Fixed several rounding error bugs during encoding. - - Added new local parameter conversion entries - -g2lib-1.0.9 - MAY 2007 - Modified Grid Definition Template 3.igds(5)(3.204) - to add Curvilinear Orthogonal grids. - - Added new local parameter conversion entries - -g2lib-1.1.0 -December 2007 - Added new local parameters conversion entries - - Declared the variable rmin,rmax in routine (jpcpack.f - and pngpack.f) with double precision fix bug causing - seg fault when using JPEG2000 encoding algorithm. - -g2lib-1.1.1 -January 2008 - Added new local parameters conversion entries - -g2lib-1.1.7 -August 2008 - Added new local parameters conversion entries - and table 131 - - Added a new Grid Definition Template number - 3.32768 (Added Rotate Lat/Lon E-grid) - -g2lib-1.1.8 -November 2008 - Added new local parameters conversion entries diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/README b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/README deleted file mode 100755 index 7fd7391e7e..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/README +++ /dev/null @@ -1,84 +0,0 @@ - Sep 04, 2008 - - -g2lib Library. - -This library contains Fortran 90 decoder/encoder -routines for GRIB edition 2, as well as indexing/searching -utility routines. The user API for the GRIB2 routines -is described in file "grib2.doc". - -Some Fortran routines call "C" functions, which must -follow a specific symbol naming convention used by your -machine/loader to be linked successfully. -If you are having trouble linking to the C routines -in this library, please make sure the appropriate -machine is defined as an option in the CFLAGS -variable in the makefile. See the first few lines -of the makefile for valid options. -Recompile the library. - -We have added support for PNG and JPEG2000 image compression -algorithms within the GRIB2 standard. If you would like -to compile this library to utilize these GRIB2 Templates, -make sure that -DUSE_PNG and -DUSE_JPEG2000 are specified -in the FDEFS variable in the makefile. You will also need -to download and install the external libraries listed below, -if they are not already installed on your system. - -If you do not wish to bother with the external libs and -don't need PNG and JPEG2000 support, you can remove the --DUSE_PNG and -DUSE_JPEG2000 flags from the FDEFS variable -in the makefile. - - -------------------------------------------------------------------------------- - - External Libraries: - -libjasper.a - This library is a C implementation of the JPEG-2000 Part-1 - standard (i.e., ISO/IEC 15444-1). This library is required - if JPEG2000 support in GRIB2 is desired. If not, remove - the -DUSE_JPEG2000 option from the FDEFS variable - in the makefile. - - Download version jasper-1.700.2 from the link belows: - http://www.nco.ncep.noaa.gov/pmb/codes/GRIB2/ - - More information about JPEG2000 can be found at - http://www.jpeg.org/JPEG2000.html. - -libpng.a This library is a C implementation of the Portable Network - Graphics PNG image compression format. This library is required - if PNG support in GRIB2 is desired. If not, remove - the -DUSE_PNG option from the FDEFS variable - in the makefile. - - If not already installed on your system, download version - libpng-1.2.5 from http://www.libpng.org/pub/png/libpng.html. - - More information about PNG can be found at - http://www.libpng.org/pub/png/. - -libz.a This library contains compression/decompression routines - used by libpng.a for PNG image compression support. - This library is required if PNG support in GRIB2 is desired. - If not, remove the -DUSE_PNG option from the FDEFS variable - in g2lib/makefile. - - If not already installed on your system, download version - zlib-1.1.4 from http://www.gzip.org/zlib/. - -------------------------------------------------------------------------------- - -A note about routine MOVA2I: - -Some routines in this library call subroutine MOVA2I, which is included in -our W3LIB library containing the GRIB1 decoder/encoder routines. If you -are using this library without libw3.a, you will need to compile mova2i.c -(included in this distribution) so it can be added to libg2.a. Just add -the line: - - $(LIB)(mova2i.o) \ - -to the list of routines in the makefile. diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addfield.F b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addfield.F deleted file mode 100755 index 51f6a5c0eb..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addfield.F +++ /dev/null @@ -1,482 +0,0 @@ - subroutine addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen, - & coordlist,numcoord,idrsnum,idrstmpl, - & idrstmplen,fld,ngrdpts,ibmap,bmap,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: addfield -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-02 -! -! ABSTRACT: This subroutine packs up Sections 4 through 7 for a given field -! and adds them to a GRIB2 message. They are Product Definition Section, -! Data Representation Section, Bit-Map Section and Data Section, -! respectively. -! This routine is used with routines "gribcreate", "addlocal", "addgrid", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! Also, subroutine addgrid must be called after gribcreate and -! before this routine to add the appropriate grid description to -! the GRIB2 message. Also, a call to gribend is required to complete -! GRIB2 message after all fields have been added. -! -! PROGRAM HISTORY LOG: -! 2000-05-02 Gilbert -! 2002-12-17 Gilbert - Added support for new templates using -! PNG and JPEG2000 algorithms/templates. -! 2004-06-22 Gilbert - Added check to determine if packing algorithm failed. -! -! USAGE: CALL addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen, -! coordlist,numcoord,idrsnum,idrstmpl, -! idrstmplen,fld,ngrdpts,ibmap,bmap,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! ipdsnum - Product Definition Template Number ( see Code Table 4.0) -! ipdstmpl - Contains the data values for the specified Product Definition -! Template ( N=ipdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 4.N -! ipdstmplen - Max dimension of ipdstmpl() -! coordlist- Array containg floating point values intended to document -! the vertical discretisation associated to model data -! on hybrid coordinate vertical levels. -! numcoord - number of values in array coordlist. -! idrsnum - Data Representation Template Number ( see Code Table 5.0 ) -! idrstmpl - Contains the data values for the specified Data Representation -! Template ( N=idrsnum ). Each element of this integer -! array contains an entry (in the order specified) of Data -! Representation Template 5.N -! Note that some values in this template (eg. reference -! values, number of bits, etc...) may be changed by the -! data packing algorithms. -! Use this to specify scaling factors and order of -! spatial differencing, if desired. -! idrstmplen - Max dimension of idrstmpl() -! fld() - Array of data points to pack. -! ngrdpts - Number of data points in grid. -! i.e. size of fld and bmap. -! ibmap - Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! bmap() - Logical*1 array containing bitmap to be added. -! ( if ibmap=0 or ibmap=254) -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. Cannot add new section. -! 3 = Sum of Section byte counts does not add to total -! byte count. -! 4 = Previous Section was not 3 or 7. -! 5 = Could not find requested Product Definition Template. -! 6 = Section 3 (GDS) not previously defined in message -! 7 = Tried to use unsupported Data Representationi Template -! 8 = Specified use of a previously defined bitmap, but one -! does not exist in the GRIB message. -! 9 = GDT of one of 5.50 through 5.53 required to pack -! using DRT 5.51 -! 10 = Error packing data field. -! -! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow -! Section 1 or Section 7 in a GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use pdstemplates - use drstemplates - - character(len=1),intent(inout) :: cgrib(lcgrib) - integer,intent(in) :: ipdsnum,ipdstmpl(*) - integer,intent(in) :: idrsnum,numcoord,ipdstmplen,idrstmplen - integer,intent(in) :: lcgrib,ngrdpts,ibmap - real,intent(in) :: coordlist(numcoord) - real,target,intent(in) :: fld(ngrdpts) - integer,intent(out) :: ierr - integer,intent(inout) :: idrstmpl(*) - logical*1,intent(in) :: bmap(ngrdpts) - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4):: ctemp - character(len=1),allocatable :: cpack(:) - real,pointer,dimension(:) :: pfld - real(4) :: coordieee(numcoord),re00 - integer(4) :: ire00,allones - integer :: mappds(ipdstmplen),intbmap(ngrdpts),mapdrs(idrstmplen) - integer,parameter :: zero=0,one=1,four=4,five=5,six=6,seven=7 - integer,parameter :: minsize=50000 - integer iofst,ibeg,lencurr,len,mappdslen,mapdrslen,lpos3 - integer width,height,ndpts - integer lensec3,lensec4,lensec5,lensec6,lensec7 - logical issec3,needext,isprevbmap - - ierr=0 - do jj=0,31 - allones=ibset(allones,jj) - enddo -! -! Check to see if beginning of GRIB message exists -! - ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4) - if ( ctemp.ne.grib ) then - print *,'addfield: GRIB not found in given message.' - print *,'addfield: Call to routine gribcreate required', - & ' to initialize GRIB messge.' - ierr=1 - return - endif -! -! Get current length of GRIB message -! - call gbyte(cgrib,lencurr,96,32) -! -! Check to see if GRIB message is already complete -! - ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1) - & //cgrib(lencurr) - if ( ctemp.eq.c7777 ) then - print *,'addfield: GRIB message already complete. Cannot', - & ' add new section.' - ierr=2 - return - endif -! -! Loop through all current sections of the GRIB message to -! find the last section number. -! - issec3=.false. - isprevbmap=.false. - len=16 ! length of Section 0 - do - ! Get number and length of next section - iofst=len*8 - call gbyte(cgrib,ilen,iofst,32) - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) - iofst=iofst+8 - ! Check if previous Section 3 exists and save location of - ! the section 3 in case needed later. - if (isecnum.eq.3) then - issec3=.true. - lpos3=len+1 - lensec3=ilen - endif - ! Check if a previous defined bitmap exists - if (isecnum.eq.6) then - call gbyte(cgrib,ibmprev,iofst,8) - iofst=iofst+8 - if ((ibmprev.ge.0).and.(ibmprev.le.253)) isprevbmap=.true. - endif - len=len+ilen - ! Exit loop if last section reached - if ( len.eq.lencurr ) exit - ! If byte count for each section does not match current - ! total length, then there is a problem. - if ( len.gt.lencurr ) then - print *,'addfield: Section byte counts don''t add to total.' - print *,'addfield: Sum of section byte counts = ',len - print *,'addfield: Total byte count in Section 0 = ',lencurr - ierr=3 - return - endif - enddo -! -! Sections 4 through 7 can only be added after section 3 or 7. -! - if ( (isecnum.ne.3) .and. (isecnum.ne.7) ) then - print *,'addfield: Sections 4-7 can only be added after', - & ' Section 3 or 7.' - print *,'addfield: Section ',isecnum,' was the last found in', - & ' given GRIB message.' - ierr=4 - return -! -! Sections 4 through 7 can only be added if section 3 was previously defined. -! - elseif (.not.issec3) then - print *,'addfield: Sections 4-7 can only be added if Section', - & ' 3 was previously included.' - print *,'addfield: Section 3 was not found in', - & ' given GRIB message.' - print *,'addfield: Call to routine addgrid required', - & ' to specify Grid definition.' - ierr=6 - return - endif -! -! Add Section 4 - Product Definition Section -! - ibeg=lencurr*8 ! Calculate offset for beginning of section 4 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,four,iofst,8) ! Store section number ( 4 ) - iofst=iofst+8 - call sbyte(cgrib,numcoord,iofst,16) ! Store num of coordinate values - iofst=iofst+16 - call sbyte(cgrib,ipdsnum,iofst,16) ! Store Prod Def Template num. - iofst=iofst+16 - ! - ! Get Product Definition Template - ! - call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret) - if (iret.ne.0) then - ierr=5 - return - endif - ! - ! Extend the Product Definition Template, if necessary. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extpdstemplate(ipdsnum,ipdstmpl,mappdslen,mappds) - endif - ! - ! Pack up each input value in array ipdstmpl into the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mappds. - ! - do i=1,mappdslen - nbits=iabs(mappds(i))*8 - if ( (mappds(i).ge.0).or.(ipdstmpl(i).ge.0) ) then - call sbyte(cgrib,ipdstmpl(i),iofst,nbits) - else - call sbyte(cgrib,one,iofst,1) - call sbyte(cgrib,iabs(ipdstmpl(i)),iofst+1,nbits-1) - endif - iofst=iofst+nbits - enddo - ! - ! Add Optional list of vertical coordinate values - ! after the Product Definition Template, if necessary. - ! - if ( numcoord .ne. 0 ) then - call mkieee(coordlist,coordieee,numcoord) - call sbytes(cgrib,coordieee,iofst,32,0,numcoord) - iofst=iofst+(32*numcoord) - endif - ! - ! Calculate length of section 4 and store it in octets - ! 1-4 of section 4. - ! - lensec4=(iofst-ibeg)/8 - call sbyte(cgrib,lensec4,ibeg,32) -! -! Pack Data using appropriate algorithm -! - ! - ! Get Data Representation Template - ! - call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret) - if (iret.ne.0) then - ierr=5 - return - endif - ! - ! contract data field, removing data at invalid grid points, - ! if bit-map is provided with field. - ! - if ( ibmap.eq.0 .OR. ibmap.eq.254 ) then - allocate(pfld(ngrdpts)) - ndpts=0; - do jj=1,ngrdpts - intbmap(jj)=0 - if ( bmap(jj) ) then - intbmap(jj)=1 - ndpts=ndpts+1 - pfld(ndpts)=fld(jj); - endif - enddo - else - ndpts=ngrdpts; - pfld=>fld; - endif - lcpack=0 - nsize=ndpts*4 - if (nsize .lt. minsize) nsize=minsize - allocate(cpack(nsize),stat=istat) - if (idrsnum.eq.0) then ! Simple Packing - call simpack(pfld,ndpts,idrstmpl,cpack,lcpack) - elseif (idrsnum.eq.2.or.idrsnum.eq.3) then ! Complex Packing - call cmplxpack(pfld,ndpts,idrsnum,idrstmpl,cpack,lcpack) - elseif (idrsnum.eq.50) then ! Sperical Harmonic Simple Packing - call simpack(pfld(2),ndpts-1,idrstmpl,cpack,lcpack) - call mkieee(real(pfld(1)),re00,1) ! ensure RE(0,0) value is IEEE format - !call gbyte(re00,idrstmpl(5),0,32) - ire00=transfer(re00,ire00) - idrstmpl(5)=ire00 - elseif (idrsnum.eq.51) then ! Sperical Harmonic Complex Packing - call getpoly(cgrib(lpos3),lensec3,jj,kk,mm) - if (jj.ne.0 .AND. kk.ne.0 .AND. mm.ne.0) then - call specpack(pfld,ndpts,jj,kk,mm,idrstmpl,cpack,lcpack) - else - print *,'addfield: Cannot pack DRT 5.51.' - ierr=9 - return - endif -#ifdef USE_JPEG2000 - elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then ! JPEG2000 encoding - if (ibmap.eq.255) then - call getdim(cgrib(lpos3),lensec3,width,height,iscan) - if ( width.eq.0 .OR. height.eq.0 ) then - width=ndpts - height=1 - elseif ( width.eq.allones .OR. height.eq.allones ) then - width=ndpts - height=1 - elseif ( ibits(iscan,5,1) .eq. 1) then ! Scanning mode: bit 3 - itemp=width - width=height - height=itemp - endif - else - width=ndpts - height=1 - endif - lcpack=nsize - call jpcpack(pfld,width,height,idrstmpl,cpack,lcpack) -#endif /* USE_JPEG2000 */ -#ifdef USE_PNG - elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then ! PNG encoding - if (ibmap.eq.255) then - call getdim(cgrib(lpos3),lensec3,width,height,iscan) - if ( width.eq.0 .OR. height.eq.0 ) then - width=ndpts - height=1 - elseif ( width.eq.allones .OR. height.eq.allones ) then - width=ndpts - height=1 - elseif ( ibits(iscan,5,1) .eq. 1) then ! Scanning mode: bit 3 - itemp=width - width=height - height=itemp - endif - else - width=ndpts - height=1 - endif - call pngpack(pfld,width,height,idrstmpl,cpack,lcpack) -#endif /* USE_PNG */ - else - print *,'addfield: Data Representation Template 5.',idrsnum, - * ' not yet implemented.' - ierr=7 - return - endif - if ( ibmap.eq.0 .OR. ibmap.eq.254 ) then - deallocate(pfld) - endif - if ( lcpack .lt. 0 ) then - if( allocated(cpack) )deallocate(cpack) - ierr=10 - return - endif - -! -! Add Section 5 - Data Representation Section -! - ibeg=iofst ! Calculate offset for beginning of section 5 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,five,iofst,8) ! Store section number ( 5 ) - iofst=iofst+8 - call sbyte(cgrib,ndpts,iofst,32) ! Store num of actual data points - iofst=iofst+32 - call sbyte(cgrib,idrsnum,iofst,16) ! Store Data Repr. Template num. - iofst=iofst+16 - ! - ! Pack up each input value in array idrstmpl into the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapdrs. - ! - do i=1,mapdrslen - nbits=iabs(mapdrs(i))*8 - if ( (mapdrs(i).ge.0).or.(idrstmpl(i).ge.0) ) then - call sbyte(cgrib,idrstmpl(i),iofst,nbits) - else - call sbyte(cgrib,one,iofst,1) - call sbyte(cgrib,iabs(idrstmpl(i)),iofst+1,nbits-1) - endif - iofst=iofst+nbits - enddo - ! - ! Calculate length of section 5 and store it in octets - ! 1-4 of section 5. - ! - lensec5=(iofst-ibeg)/8 - call sbyte(cgrib,lensec5,ibeg,32) - -! -! Add Section 6 - Bit-Map Section -! - ibeg=iofst ! Calculate offset for beginning of section 6 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,six,iofst,8) ! Store section number ( 6 ) - iofst=iofst+8 - call sbyte(cgrib,ibmap,iofst,8) ! Store Bit Map indicator - iofst=iofst+8 - ! - ! Store bitmap, if supplied - ! - if (ibmap.eq.0) then - call sbytes(cgrib,intbmap,iofst,1,0,ngrdpts) ! Store BitMap - iofst=iofst+ngrdpts - endif - ! - ! If specifying a previously defined bit-map, make sure - ! one already exists in the current GRIB message. - ! - if ((ibmap.eq.254).and.(.not.isprevbmap)) then - print *,'addfield: Requested previously defined bitmap, ', - & ' but one does not exist in the current GRIB message.' - ierr=8 - return - endif - ! - ! Calculate length of section 6 and store it in octets - ! 1-4 of section 6. Pad to end of octect, if necessary. - ! - left=8-mod(iofst,8) - if (left.ne.8) then - call sbyte(cgrib,zero,iofst,left) ! Pad with zeros to fill Octet - iofst=iofst+left - endif - lensec6=(iofst-ibeg)/8 - call sbyte(cgrib,lensec6,ibeg,32) - -! -! Add Section 7 - Data Section -! - ibeg=iofst ! Calculate offset for beginning of section 7 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,seven,iofst,8) ! Store section number ( 7 ) - iofst=iofst+8 - ! Store Packed Binary Data values, if non-constant field - if (lcpack.ne.0) then - ioctet=iofst/8 - cgrib(ioctet+1:ioctet+lcpack)=cpack(1:lcpack) - iofst=iofst+(8*lcpack) - endif - ! - ! Calculate length of section 7 and store it in octets - ! 1-4 of section 7. - ! - lensec7=(iofst-ibeg)/8 - call sbyte(cgrib,lensec7,ibeg,32) - - if( allocated(cpack) )deallocate(cpack) -! -! Update current byte total of message in Section 0 -! - newlen=lencurr+lensec4+lensec5+lensec6+lensec7 - call sbyte(cgrib,newlen,96,32) - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addgrid.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addgrid.f deleted file mode 100755 index c8ccba17c2..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addgrid.f +++ /dev/null @@ -1,228 +0,0 @@ - subroutine addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen, - & ideflist,idefnum,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: addgrid -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-01 -! -! ABSTRACT: This subroutine packs up a Grid Definition Section (Section 3) -! and adds it to a GRIB2 message. -! This routine is used with routines "gribcreate", "addlocal", "addfield", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-01 Gilbert -! -! USAGE: CALL addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen, -! ideflist,idefnum,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! igds - Contains information needed for GRIB Grid Definition Section 3. -! Must be dimensioned >= 5. -! igds(1)=Source of grid definition (see Code Table 3.0) -! igds(2)=Number of grid points in the defined grid. -! igds(3)=Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! igds(4)=Interpretation of list for optional points -! definition. (Code Table 3.11) -! igds(5)=Grid Definition Template Number (Code Table 3.1) -! igdstmpl - Contains the data values for the specified Grid Definition -! Template ( NN=igds(5) ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Defintion Template 3.NN -! igdstmplen - Max dimension of igdstmpl() -! ideflist - (Used if igds(3) .ne. 0) This array contains the -! number of grid points contained in each row ( or column ) -! idefnum - (Used if igds(3) .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. Cannot add new section. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 1, 2 or 7. -! 5 = Could not find requested Grid Definition Template. -! -! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow -! Section 1 or Section 7 in a GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use gridtemplates - - character(len=1),intent(inout) :: cgrib(lcgrib) - integer,intent(in) :: igds(*),igdstmpl(*),ideflist(idefnum) - integer,intent(in) :: lcgrib,idefnum,igdstmplen - integer,intent(out) :: ierr - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4):: ctemp - integer:: mapgrid(igdstmplen) - integer,parameter :: one=1,three=3 - integer lensec3,iofst,ibeg,lencurr,len,mapgridlen - logical needext - - ierr=0 -! -! Check to see if beginning of GRIB message exists -! - ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4) - if ( ctemp.ne.grib ) then - print *,'addgrid: GRIB not found in given message.' - print *,'addgrid: Call to routine gribcreate required', - & ' to initialize GRIB messge.' - ierr=1 - return - endif -! -! Get current length of GRIB message -! - call gbyte(cgrib,lencurr,96,32) -! -! Check to see if GRIB message is already complete -! - ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1) - & //cgrib(lencurr) - if ( ctemp.eq.c7777 ) then - print *,'addgrid: GRIB message already complete. Cannot', - & ' add new section.' - ierr=2 - return - endif -! -! Loop through all current sections of the GRIB message to -! find the last section number. -! - len=16 ! length of Section 0 - do - ! Get section number and length of next section - iofst=len*8 - call gbyte(cgrib,ilen,iofst,32) - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) - len=len+ilen - ! Exit loop if last section reached - if ( len.eq.lencurr ) exit - ! If byte count for each section doesn't match current - ! total length, then there is a problem. - if ( len.gt.lencurr ) then - print *,'addgrid: Section byte counts don''t add to total.' - print *,'addgrid: Sum of section byte counts = ',len - print *,'addgrid: Total byte count in Section 0 = ',lencurr - ierr=3 - return - endif - enddo -! -! Section 3 can only be added after sections 1, 2 and 7. -! - if ( (isecnum.ne.1) .and. (isecnum.ne.2) .and. - & (isecnum.ne.7) ) then - print *,'addgrid: Section 3 can only be added after Section', - & ' 1, 2 or 7.' - print *,'addgrid: Section ',isecnum,' was the last found in', - & ' given GRIB message.' - ierr=4 - return - endif -! -! Add Section 3 - Grid Definition Section -! - ibeg=lencurr*8 ! Calculate offset for beginning of section 3 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,three,iofst,8) ! Store section number ( 3 ) - iofst=iofst+8 - call sbyte(cgrib,igds(1),iofst,8) ! Store source of Grid def. - iofst=iofst+8 - call sbyte(cgrib,igds(2),iofst,32) ! Store number of data pts. - iofst=iofst+32 - call sbyte(cgrib,igds(3),iofst,8) ! Store number of extra octets. - iofst=iofst+8 - call sbyte(cgrib,igds(4),iofst,8) ! Store interp. of extra octets. - iofst=iofst+8 - ! if Octet 6 is not equal to zero, Grid Definition Template may - ! not be supplied. - if ( igds(1).eq.0 ) then - call sbyte(cgrib,igds(5),iofst,16) ! Store Grid Def Template num. - else - call sbyte(cgrib,65535,iofst,16) ! Store missing value as Grid Def Template num. - endif - iofst=iofst+16 - ! - ! Get Grid Definition Template - ! - if (igds(1).eq.0) then - call getgridtemplate(igds(5),mapgridlen,mapgrid,needext, - & iret) - if (iret.ne.0) then - ierr=5 - return - endif - ! - ! Extend the Grid Definition Template, if necessary. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extgridtemplate(igds(5),igdstmpl,mapgridlen,mapgrid) - endif - else - mapgridlen=0 - endif - ! - ! Pack up each input value in array igdstmpl into the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapgrid. - ! - do i=1,mapgridlen - nbits=iabs(mapgrid(i))*8 - if ( (mapgrid(i).ge.0).or.(igdstmpl(i).ge.0) ) then - call sbyte(cgrib,igdstmpl(i),iofst,nbits) - else - call sbyte(cgrib,one,iofst,1) - call sbyte(cgrib,iabs(igdstmpl(i)),iofst+1,nbits-1) - endif - iofst=iofst+nbits - enddo - ! - ! If requested, - ! Insert optional list of numbers defining number of points - ! in each row or column. This is used for non regular - ! grids. - ! - if ( igds(3).ne.0 ) then - nbits=igds(3)*8 - call sbytes(cgrib,ideflist,iofst,nbits,0,idefnum) - iofst=iofst+(nbits*idefnum) - endif - ! - ! Calculate length of section 3 and store it in octets - ! 1-4 of section 3. - ! - lensec3=(iofst-ibeg)/8 - call sbyte(cgrib,lensec3,ibeg,32) - -! -! Update current byte total of message in Section 0 -! - call sbyte(cgrib,lencurr+lensec3,96,32) - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addlocal.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addlocal.f deleted file mode 100755 index 6c184f31b1..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/addlocal.f +++ /dev/null @@ -1,138 +0,0 @@ - subroutine addlocal(cgrib,lcgrib,csec2,lcsec2,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: addlocal -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-01 -! -! ABSTRACT: This subroutine adds a Local Use Section (Section 2) to -! a GRIB2 message. -! This routine is used with routines "gribcreate", "addgrid", "addfield", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-01 Gilbert -! -! USAGE: CALL addlocal(cgrib,lcgrib,csec2,lcsec2,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! csec2 - Character array containing information to be added to -! Section 2. -! lcsec2 - Number of bytes of character array csec2 to be added to -! Section 2. -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. Cannot add new section. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 1 or 7. -! -! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow -! Section 1 or Section 7 in a GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(inout) :: cgrib(lcgrib) - character(len=1),intent(in) :: csec2(lcsec2) - integer,intent(in) :: lcgrib,lcsec2 - integer,intent(out) :: ierr - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4):: ctemp - integer,parameter :: two=2 - integer lensec2,iofst,ibeg,lencurr,len - - ierr=0 -! -! Check to see if beginning of GRIB message exists -! - ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4) - if ( ctemp.ne.grib ) then - print *,'addlocal: GRIB not found in given message.' - print *,'addlocal: Call to routine gribcreate required', - & ' to initialize GRIB messge.' - ierr=1 - return - endif -! -! Get current length of GRIB message -! - call gbyte(cgrib,lencurr,96,32) -! -! Check to see if GRIB message is already complete -! - ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1) - & //cgrib(lencurr) - if ( ctemp.eq.c7777 ) then - print *,'addlocal: GRIB message already complete. Cannot', - & ' add new section.' - ierr=2 - return - endif -! -! Loop through all current sections of the GRIB message to -! find the last section number. -! - len=16 ! length of Section 0 - do - ! Get section number and length of next section - iofst=len*8 - call gbyte(cgrib,ilen,iofst,32) - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) - len=len+ilen - ! Exit loop if last section reached - if ( len.eq.lencurr ) exit - ! If byte count for each section doesn't match current - ! total length, then there is a problem. - if ( len.gt.lencurr ) then - print *,'addlocal: Section byte counts don''t add to total.' - print *,'addlocal: Sum of section byte counts = ',len - print *,'addlocal: Total byte count in Section 0 = ',lencurr - ierr=3 - return - endif - enddo -! -! Section 2 can only be added after sections 1 and 7. -! - if ( (isecnum.ne.1) .and. (isecnum.ne.7) ) then - print *,'addlocal: Section 2 can only be added after Section', - & ' 1 or Section 7.' - print *,'addlocal: Section ',isecnum,' was the last found in', - & ' given GRIB message.' - ierr=4 - return - endif -! -! Add Section 2 - Local Use Section -! - ibeg=lencurr*8 ! Calculate offset for beginning of section 2 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,two,iofst,8) ! Store section number ( 2 ) - istart=lencurr+5 - cgrib(istart+1:istart+lcsec2)=csec2(1:lcsec2) - ! - ! Calculate length of section 2 and store it in octets - ! 1-4 of section 2. - ! - lensec2=lcsec2+5 ! bytes - call sbyte(cgrib,lensec2,ibeg,32) - -! -! Update current byte total of message in Section 0 -! - call sbyte(cgrib,lencurr+lensec2,96,32) - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/cmplxpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/cmplxpack.f deleted file mode 100755 index dd1be9e1ed..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/cmplxpack.f +++ /dev/null @@ -1,76 +0,0 @@ - subroutine cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: cmplxpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-08-27 -! -! ABSTRACT: This subroutine packs up a data field using a complex -! packing algorithm as defined in the GRIB2 documention. It -! supports GRIB2 complex packing templates with or without -! spatial differences (i.e. DRTs 5.2 and 5.3). -! It also fills in GRIB2 Data Representation Template 5.2 or 5.3 -! with the appropriate values. -! -! PROGRAM HISTORY LOG: -! 2004-08-27 Gilbert -! -! USAGE: CALL cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the data values to pack -! ndpts - The number of data values in array fld() -! idrsnum - Data Representation Template number 5.N -! Must equal 2 or 3. -! idrstmpl - Contains the array of values for Data Representation -! Template 5.2 or 5.3 -! (1) = Reference value - ignored on input -! (2) = Binary Scale Factor -! (3) = Decimal Scale Factor -! . -! . -! (7) = Missing value management -! (8) = Primary missing value -! (9) = Secondary missing value -! . -! . -! (17) = Order of Spatial Differencing ( 1 or 2 ) -! . -! . -! -! OUTPUT ARGUMENT LIST: -! idrstmpl - Contains the array of values for Data Representation -! Template 5.3 -! (1) = Reference value - set by compack routine. -! (2) = Binary Scale Factor - unchanged from input -! (3) = Decimal Scale Factor - unchanged from input -! . -! . -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,intent(in) :: ndpts,idrsnum - real,intent(in) :: fld(ndpts) - character(len=1),intent(out) :: cpack(*) - integer,intent(inout) :: idrstmpl(*) - integer,intent(out) :: lcpack - - - - if ( idrstmpl(7) .eq. 0 ) then ! No internal missing values - call compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) - elseif ( idrstmpl(7).eq.1 .OR. idrstmpl(7).eq.2) then - call misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) - else - print *,'cmplxpack: Don:t recognize Missing value option.' - lcpack=-1 - endif - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/compack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/compack.f deleted file mode 100755 index c1779abe74..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/compack.f +++ /dev/null @@ -1,408 +0,0 @@ - subroutine compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: compack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21 -! -! ABSTRACT: This subroutine packs up a data field using a complex -! packing algorithm as defined in the GRIB2 documention. It -! supports GRIB2 complex packing templates with or without -! spatial differences (i.e. DRTs 5.2 and 5.3). -! It also fills in GRIB2 Data Representation Template 5.2 or 5.3 -! with the appropriate values. -! -! PROGRAM HISTORY LOG: -! 2000-06-21 Gilbert -! -! USAGE: CALL compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the data values to pack -! ndpts - The number of data values in array fld() -! idrsnum - Data Representation Template number 5.N -! Must equal 2 or 3. -! idrstmpl - Contains the array of values for Data Representation -! Template 5.2 or 5.3 -! (1) = Reference value - ignored on input -! (2) = Binary Scale Factor -! (3) = Decimal Scale Factor -! . -! . -! (7) = Missing value management -! (8) = Primary missing value -! (9) = Secondary missing value -! . -! . -! (17) = Order of Spatial Differencing ( 1 or 2 ) -! . -! . -! -! OUTPUT ARGUMENT LIST: -! idrstmpl - Contains the array of values for Data Representation -! Template 5.3 -! (1) = Reference value - set by compack routine. -! (2) = Binary Scale Factor - unchanged from input -! (3) = Decimal Scale Factor - unchanged from input -! . -! . -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,intent(in) :: ndpts,idrsnum - real,intent(in) :: fld(ndpts) - character(len=1),intent(out) :: cpack(*) - integer,intent(inout) :: idrstmpl(*) - integer,intent(out) :: lcpack - - real(4) :: ref - integer(4) :: iref - integer,allocatable :: ifld(:) - integer,allocatable :: jmin(:),jmax(:),lbit(:) - integer,parameter :: zero=0 - integer,allocatable :: gref(:),gwidth(:),glen(:) - integer :: glength,grpwidth - logical :: simple_alg = .false. - - alog2=alog(2.0) - bscale=2.0**real(-idrstmpl(2)) - dscale=10.0**real(idrstmpl(3)) -! -! Find max and min values in the data -! - rmax=fld(1) - rmin=fld(1) - do j=2,ndpts - if (fld(j).gt.rmax) rmax=fld(j) - if (fld(j).lt.rmin) rmin=fld(j) - enddo -! -! If max and min values are not equal, pack up field. -! If they are equal, we have a constant field, and the reference -! value (rmin) is the value for each point in the field and -! set nbits to 0. -! - if (rmin.ne.rmax) then - iofst=0 - allocate(ifld(ndpts)) - allocate(gref(ndpts)) - allocate(gwidth(ndpts)) - allocate(glen(ndpts)) - ! - ! Scale original data - ! - if (idrstmpl(2).eq.0) then ! No binary scaling - imin=nint(rmin*dscale) - !imax=nint(rmax*dscale) - rmin=real(imin) - do j=1,ndpts - ifld(j)=nint(fld(j)*dscale)-imin - enddo - else ! Use binary scaling factor - rmin=rmin*dscale - !rmax=rmax*dscale - do j=1,ndpts - ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale) - enddo - endif - ! - ! Calculate Spatial differences, if using DRS Template 5.3 - ! - if (idrsnum.eq.3) then ! spatial differences - if (idrstmpl(17).ne.1.and.idrstmpl(17).ne.2) idrstmpl(17)=2 - if (idrstmpl(17).eq.1) then ! first order - ival1=ifld(1) - do j=ndpts,2,-1 - ifld(j)=ifld(j)-ifld(j-1) - enddo - ifld(1)=0 - elseif (idrstmpl(17).eq.2) then ! second order - ival1=ifld(1) - ival2=ifld(2) - do j=ndpts,3,-1 - ifld(j)=ifld(j)-(2*ifld(j-1))+ifld(j-2) - enddo - ifld(1)=0 - ifld(2)=0 - endif - ! - ! subtract min value from spatial diff field - ! - isd=idrstmpl(17)+1 - minsd=minval(ifld(isd:ndpts)) - do j=isd,ndpts - ifld(j)=ifld(j)-minsd - enddo - ! - ! find num of bits need to store minsd and add 1 extra bit - ! to indicate sign - ! - temp=alog(real(abs(minsd)+1))/alog2 - nbitsd=ceiling(temp)+1 - ! - ! find num of bits need to store ifld(1) ( and ifld(2) - ! if using 2nd order differencing ) - ! - maxorig=ival1 - if (idrstmpl(17).eq.2.and.ival2.gt.ival1) maxorig=ival2 - temp=alog(real(maxorig+1))/alog2 - nbitorig=ceiling(temp)+1 - if (nbitorig.gt.nbitsd) nbitsd=nbitorig - ! increase number of bits to even multiple of 8 ( octet ) - if (mod(nbitsd,8).ne.0) nbitsd=nbitsd+(8-mod(nbitsd,8)) - ! - ! Store extra spatial differencing info into the packed - ! data section. - ! - if (nbitsd.ne.0) then - ! pack first original value - if (ival1.ge.0) then - call sbyte(cpack,ival1,iofst,nbitsd) - iofst=iofst+nbitsd - else - call sbyte(cpack,1,iofst,1) - iofst=iofst+1 - call sbyte(cpack,iabs(ival1),iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - endif - if (idrstmpl(17).eq.2) then - ! pack second original value - if (ival2.ge.0) then - call sbyte(cpack,ival2,iofst,nbitsd) - iofst=iofst+nbitsd - else - call sbyte(cpack,1,iofst,1) - iofst=iofst+1 - call sbyte(cpack,iabs(ival2),iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - endif - endif - ! pack overall min of spatial differences - if (minsd.ge.0) then - call sbyte(cpack,minsd,iofst,nbitsd) - iofst=iofst+nbitsd - else - call sbyte(cpack,1,iofst,1) - iofst=iofst+1 - call sbyte(cpack,iabs(minsd),iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - endif - endif - !print *,'SDp ',ival1,ival2,minsd,nbitsd - endif ! end of spatial diff section - ! - ! Determine Groups to be used. - ! - if ( simple_alg ) then - ! set group length to 10 : calculate number of groups - ! and length of last group - ngroups=ndpts/10 - glen(1:ngroups)=10 - itemp=mod(ndpts,10) - if (itemp.ne.0) then - ngroups=ngroups+1 - glen(ngroups)=itemp - endif - else - ! Use Dr. Glahn's algorithm for determining grouping. - ! - kfildo=6 - minpk=10 - inc=1 - maxgrps=(ndpts/minpk)+1 - allocate(jmin(maxgrps)) - allocate(jmax(maxgrps)) - allocate(lbit(maxgrps)) - missopt=0 - call pack_gp(kfildo,ifld,ndpts,missopt,minpk,inc,miss1,miss2, - & jmin,jmax,lbit,glen,maxgrps,ngroups,ibit,jbit, - & kbit,novref,lbitref,ier) - !print *,'SAGier = ',ier,ibit,jbit,kbit,novref,lbitref - do ng=1,ngroups - glen(ng)=glen(ng)+novref - enddo - deallocate(jmin) - deallocate(jmax) - deallocate(lbit) - endif - ! - ! For each group, find the group's reference value - ! and the number of bits needed to hold the remaining values - ! - n=1 - do ng=1,ngroups - ! find max and min values of group - gref(ng)=ifld(n) - imax=ifld(n) - j=n+1 - do lg=2,glen(ng) - if (ifld(j).lt.gref(ng)) gref(ng)=ifld(j) - if (ifld(j).gt.imax) imax=ifld(j) - j=j+1 - enddo - ! calc num of bits needed to hold data - if ( gref(ng).ne.imax ) then - temp=alog(real(imax-gref(ng)+1))/alog2 - gwidth(ng)=ceiling(temp) - else - gwidth(ng)=0 - endif - ! Subtract min from data - j=n - do lg=1,glen(ng) - ifld(j)=ifld(j)-gref(ng) - j=j+1 - enddo - ! increment fld array counter - n=n+glen(ng) - enddo - ! - ! Find max of the group references and calc num of bits needed - ! to pack each groups reference value, then - ! pack up group reference values - ! - !write(77,*)'GREFS: ',(gref(j),j=1,ngroups) - igmax=maxval(gref(1:ngroups)) - if (igmax.ne.0) then - temp=alog(real(igmax+1))/alog2 - nbitsgref=ceiling(temp) - call sbytes(cpack,gref,iofst,nbitsgref,0,ngroups) - itemp=nbitsgref*ngroups - iofst=iofst+itemp - ! Pad last octet with Zeros, if necessary, - if (mod(itemp,8).ne.0) then - left=8-mod(itemp,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - else - nbitsgref=0 - endif - ! - ! Find max/min of the group widths and calc num of bits needed - ! to pack each groups width value, then - ! pack up group width values - ! - !write(77,*)'GWIDTHS: ',(gwidth(j),j=1,ngroups) - iwmax=maxval(gwidth(1:ngroups)) - ngwidthref=minval(gwidth(1:ngroups)) - if (iwmax.ne.ngwidthref) then - temp=alog(real(iwmax-ngwidthref+1))/alog2 - nbitsgwidth=ceiling(temp) - do i=1,ngroups - gwidth(i)=gwidth(i)-ngwidthref - enddo - call sbytes(cpack,gwidth,iofst,nbitsgwidth,0,ngroups) - itemp=nbitsgwidth*ngroups - iofst=iofst+itemp - ! Pad last octet with Zeros, if necessary, - if (mod(itemp,8).ne.0) then - left=8-mod(itemp,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - else - nbitsgwidth=0 - gwidth(1:ngroups)=0 - endif - ! - ! Find max/min of the group lengths and calc num of bits needed - ! to pack each groups length value, then - ! pack up group length values - ! - !write(77,*)'GLENS: ',(glen(j),j=1,ngroups) - ilmax=maxval(glen(1:ngroups-1)) - nglenref=minval(glen(1:ngroups-1)) - nglenlast=glen(ngroups) - if (ilmax.ne.nglenref) then - temp=alog(real(ilmax-nglenref+1))/alog2 - nbitsglen=ceiling(temp) - do i=1,ngroups-1 - glen(i)=glen(i)-nglenref - enddo - call sbytes(cpack,glen,iofst,nbitsglen,0,ngroups) - itemp=nbitsglen*ngroups - iofst=iofst+itemp - ! Pad last octet with Zeros, if necessary, - if (mod(itemp,8).ne.0) then - left=8-mod(itemp,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - else - nbitsglen=0 - glen(1:ngroups)=0 - endif - ! - ! For each group, pack data values - ! - !write(77,*)'IFLDS: ',(ifld(j),j=1,ndpts) - n=1 - ij=0 - do ng=1,ngroups - glength=glen(ng)+nglenref - if (ng.eq.ngroups ) glength=nglenlast - grpwidth=gwidth(ng)+ngwidthref - !write(77,*)'NGP ',ng,grpwidth,glength,gref(ng) - if ( grpwidth.ne.0 ) then - call sbytes(cpack,ifld(n),iofst,grpwidth,0,glength) - iofst=iofst+(grpwidth*glength) - endif - do kk=1,glength - ij=ij+1 - !write(77,*)'SAG ',ij,fld(ij),ifld(ij),gref(ng),bscale,rmin,dscale - enddo - n=n+glength - enddo - ! Pad last octet with Zeros, if necessary, - if (mod(iofst,8).ne.0) then - left=8-mod(iofst,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - lcpack=iofst/8 - ! - if ( allocated(ifld) ) deallocate(ifld) - if ( allocated(gref) ) deallocate(gref) - if ( allocated(gwidth) ) deallocate(gwidth) - if ( allocated(glen) ) deallocate(glen) - else ! Constant field ( max = min ) - nbits=0 - lcpack=0 - nbitsgref=0 - ngroups=0 - endif - -! -! Fill in ref value and number of bits in Template 5.2 -! - call mkieee(rmin,ref,1) ! ensure reference value is IEEE format -! call gbyte(ref,idrstmpl(1),0,32) - iref=transfer(ref,iref) - idrstmpl(1)=iref - idrstmpl(4)=nbitsgref - idrstmpl(5)=0 ! original data were reals - idrstmpl(6)=1 ! general group splitting - idrstmpl(7)=0 ! No internal missing values - idrstmpl(8)=0 ! Primary missing value - idrstmpl(9)=0 ! secondary missing value - idrstmpl(10)=ngroups ! Number of groups - idrstmpl(11)=ngwidthref ! reference for group widths - idrstmpl(12)=nbitsgwidth ! num bits used for group widths - idrstmpl(13)=nglenref ! Reference for group lengths - idrstmpl(14)=1 ! length increment for group lengths - idrstmpl(15)=nglenlast ! True length of last group - idrstmpl(16)=nbitsglen ! num bits used for group lengths - if (idrsnum.eq.3) then - idrstmpl(18)=nbitsd/8 ! num bits used for extra spatial - ! differencing values - endif - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/comunpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/comunpack.f deleted file mode 100755 index 8cacc3095f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/comunpack.f +++ /dev/null @@ -1,336 +0,0 @@ - subroutine comunpack(cpack,len,lensec,idrsnum,idrstmpl,ndpts, - & fld,ier) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: comunpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21 -! -! ABSTRACT: This subroutine unpacks a data field that was packed using a -! complex packing algorithm as defined in the GRIB2 documention, -! using info from the GRIB2 Data Representation Template 5.2 or 5.3. -! Supports GRIB2 complex packing templates with or without -! spatial differences (i.e. DRTs 5.2 and 5.3). -! -! PROGRAM HISTORY LOG: -! 2000-06-21 Gilbert -! 2004-12-29 Gilbert - Added test ( provided by Arthur Taylor/MDL ) -! to verify that group widths and lengths are -! consistent with section length. -! -! USAGE: CALL comunpack(cpack,len,lensec,idrsnum,idrstmpl,ndpts,fld,ier) -! INPUT ARGUMENT LIST: -! cpack - The packed data field (character*1 array) -! len - length of packed field cpack(). -! lensec - length of section 7 (used for error checking). -! idrsnum - Data Representation Template number 5.N -! Must equal 2 or 3. -! idrstmpl - Contains the array of values for Data Representation -! Template 5.2 or 5.3 -! ndpts - The number of data values to unpack -! -! OUTPUT ARGUMENT LIST: -! fld() - Contains the unpacked data values -! ier - Error return: -! 0 = OK -! 1 = Problem - inconsistent group lengths of widths. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cpack(len) - integer,intent(in) :: ndpts,len - integer,intent(in) :: idrstmpl(*) - real,intent(out) :: fld(ndpts) - - integer,allocatable :: ifld(:),ifldmiss(:) - integer(4) :: ieee - integer,allocatable :: gref(:),gwidth(:),glen(:) - real :: ref,bscale,dscale,rmiss1,rmiss2 -! real :: fldo(6045) - integer :: totBit, totLen - - ier=0 - !print *,'IDRSTMPL: ',(idrstmpl(j),j=1,16) - ieee = idrstmpl(1) - call rdieee(ieee,ref,1) - bscale = 2.0**real(idrstmpl(2)) - dscale = 10.0**real(-idrstmpl(3)) - nbitsgref = idrstmpl(4) - itype = idrstmpl(5) - ngroups = idrstmpl(10) - nbitsgwidth = idrstmpl(12) - nbitsglen = idrstmpl(16) - if (idrsnum.eq.3) then - nbitsd=idrstmpl(18)*8 - endif - - ! Constant field - - if (ngroups.eq.0) then - do j=1,ndpts - fld(j)=ref - enddo - return - endif - - iofst=0 - allocate(ifld(ndpts),stat=is) - !print *,'ALLOC ifld: ',is,ndpts - allocate(gref(ngroups),stat=is) - !print *,'ALLOC gref: ',is - allocate(gwidth(ngroups),stat=is) - !print *,'ALLOC gwidth: ',is -! -! Get missing values, if supplied -! - if ( idrstmpl(7).eq.1 ) then - if (itype.eq.0) then - call rdieee(idrstmpl(8),rmiss1,1) - else - rmiss1=real(idrstmpl(8)) - endif - elseif ( idrstmpl(7).eq.2 ) then - if (itype.eq.0) then - call rdieee(idrstmpl(8),rmiss1,1) - call rdieee(idrstmpl(9),rmiss2,1) - else - rmiss1=real(idrstmpl(8)) - rmiss2=real(idrstmpl(9)) - endif - endif - !print *,'RMISSs: ',rmiss1,rmiss2,ref -! -! Extract Spatial differencing values, if using DRS Template 5.3 -! - if (idrsnum.eq.3) then - if (nbitsd.ne.0) then - call gbyte(cpack,isign,iofst,1) - iofst=iofst+1 - call gbyte(cpack,ival1,iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - if (isign.eq.1) ival1=-ival1 - if (idrstmpl(17).eq.2) then - call gbyte(cpack,isign,iofst,1) - iofst=iofst+1 - call gbyte(cpack,ival2,iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - if (isign.eq.1) ival2=-ival2 - endif - call gbyte(cpack,isign,iofst,1) - iofst=iofst+1 - call gbyte(cpack,minsd,iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - if (isign.eq.1) minsd=-minsd - else - ival1=0 - ival2=0 - minsd=0 - endif - !print *,'SDu ',ival1,ival2,minsd,nbitsd - endif -! -! Extract Each Group's reference value -! - !print *,'SAG1: ',nbitsgref,ngroups,iofst - if (nbitsgref.ne.0) then - call gbytes(cpack,gref,iofst,nbitsgref,0,ngroups) - itemp=nbitsgref*ngroups - iofst=iofst+(itemp) - if (mod(itemp,8).ne.0) iofst=iofst+(8-mod(itemp,8)) - else - gref(1:ngroups)=0 - endif - !write(78,*)'GREFs: ',(gref(j),j=1,ngroups) -! -! Extract Each Group's bit width -! - !print *,'SAG2: ',nbitsgwidth,ngroups,iofst,idrstmpl(11) - if (nbitsgwidth.ne.0) then - call gbytes(cpack,gwidth,iofst,nbitsgwidth,0,ngroups) - itemp=nbitsgwidth*ngroups - iofst=iofst+(itemp) - if (mod(itemp,8).ne.0) iofst=iofst+(8-mod(itemp,8)) - else - gwidth(1:ngroups)=0 - endif - do j=1,ngroups - gwidth(j)=gwidth(j)+idrstmpl(11) - enddo - !write(78,*)'GWIDTHs: ',(gwidth(j),j=1,ngroups) -! -! Extract Each Group's length (number of values in each group) -! - allocate(glen(ngroups),stat=is) - !print *,'ALLOC glen: ',is - !print *,'SAG3: ',nbitsglen,ngroups,iofst,idrstmpl(14),idrstmpl(13) - if (nbitsglen.ne.0) then - call gbytes(cpack,glen,iofst,nbitsglen,0,ngroups) - itemp=nbitsglen*ngroups - iofst=iofst+(itemp) - if (mod(itemp,8).ne.0) iofst=iofst+(8-mod(itemp,8)) - else - glen(1:ngroups)=0 - endif - do j=1,ngroups - glen(j)=(glen(j)*idrstmpl(14))+idrstmpl(13) - enddo - glen(ngroups)=idrstmpl(15) - !write(78,*)'GLENs: ',(glen(j),j=1,ngroups) - !print *,'GLENsum: ',sum(glen) -! -! Test to see if the group widths and lengths are consistent with number of -! values, and length of section 7. -! - totBit = 0 - totLen = 0 - do j=1,ngroups - totBit = totBit + (gwidth(j)*glen(j)); - totLen = totLen + glen(j); - enddo - if (totLen .NE. ndpts) then - ier=1 - return - endif - if ( (totBit/8) .GT. lensec) then - ier=1 - return - endif -! -! For each group, unpack data values -! - if ( idrstmpl(7).eq.0 ) then ! no missing values - n=1 - do j=1,ngroups - !write(78,*)'NGP ',j,gwidth(j),glen(j),gref(j) - if (gwidth(j).ne.0) then - call gbytes(cpack,ifld(n),iofst,gwidth(j),0,glen(j)) - do k=1,glen(j) - ifld(n)=ifld(n)+gref(j) - n=n+1 - enddo - else - ifld(n:n+glen(j)-1)=gref(j) - n=n+glen(j) - endif - iofst=iofst+(gwidth(j)*glen(j)) - enddo - elseif ( idrstmpl(7).eq.1.OR.idrstmpl(7).eq.2 ) then - ! missing values included - allocate(ifldmiss(ndpts)) - !ifldmiss=0 - n=1 - non=1 - do j=1,ngroups - !print *,'SAGNGP ',j,gwidth(j),glen(j),gref(j) - if (gwidth(j).ne.0) then - msng1=(2**gwidth(j))-1 - msng2=msng1-1 - call gbytes(cpack,ifld(n),iofst,gwidth(j),0,glen(j)) - iofst=iofst+(gwidth(j)*glen(j)) - do k=1,glen(j) - if (ifld(n).eq.msng1) then - ifldmiss(n)=1 - elseif (idrstmpl(7).eq.2.AND.ifld(n).eq.msng2) then - ifldmiss(n)=2 - else - ifldmiss(n)=0 - ifld(non)=ifld(n)+gref(j) - non=non+1 - endif - n=n+1 - enddo - else - msng1=(2**nbitsgref)-1 - msng2=msng1-1 - if (gref(j).eq.msng1) then - ifldmiss(n:n+glen(j)-1)=1 - !ifld(n:n+glen(j)-1)=0 - elseif (idrstmpl(7).eq.2.AND.gref(j).eq.msng2) then - ifldmiss(n:n+glen(j)-1)=2 - !ifld(n:n+glen(j)-1)=0 - else - ifldmiss(n:n+glen(j)-1)=0 - ifld(non:non+glen(j)-1)=gref(j) - non=non+glen(j) - endif - n=n+glen(j) - endif - enddo - endif - !write(78,*)'IFLDs: ',(ifld(j),j=1,ndpts) - - if ( allocated(gref) ) deallocate(gref) - if ( allocated(gwidth) ) deallocate(gwidth) - if ( allocated(glen) ) deallocate(glen) -! -! If using spatial differences, add overall min value, and -! sum up recursively -! - if (idrsnum.eq.3) then ! spatial differencing - if (idrstmpl(17).eq.1) then ! first order - ifld(1)=ival1 - if ( idrstmpl(7).eq.0 ) then ! no missing values - itemp=ndpts - else - itemp=non-1 - endif - do n=2,itemp - ifld(n)=ifld(n)+minsd - ifld(n)=ifld(n)+ifld(n-1) - enddo - elseif (idrstmpl(17).eq.2) then ! second order - ifld(1)=ival1 - ifld(2)=ival2 - if ( idrstmpl(7).eq.0 ) then ! no missing values - itemp=ndpts - else - itemp=non-1 - endif - do n=3,itemp - ifld(n)=ifld(n)+minsd - ifld(n)=ifld(n)+(2*ifld(n-1))-ifld(n-2) - enddo - endif - !write(78,*)'IFLDs: ',(ifld(j),j=1,ndpts) - endif -! -! Scale data back to original form -! - !print *,'SAGT: ',ref,bscale,dscale - if ( idrstmpl(7).eq.0 ) then ! no missing values - do n=1,ndpts - fld(n)=((real(ifld(n))*bscale)+ref)*dscale - !write(78,*)'SAG ',n,fld(n),ifld(n),bscale,ref,1./dscale - enddo - elseif ( idrstmpl(7).eq.1.OR.idrstmpl(7).eq.2 ) then - ! missing values included - non=1 - do n=1,ndpts - if ( ifldmiss(n).eq.0 ) then - fld(n)=((real(ifld(non))*bscale)+ref)*dscale - !print *,'SAG ',n,fld(n),ifld(non),bscale,ref,dscale - non=non+1 - elseif ( ifldmiss(n).eq.1 ) then - fld(n)=rmiss1 - elseif ( ifldmiss(n).eq.2 ) then - fld(n)=rmiss2 - endif - enddo - if ( allocated(ifldmiss) ) deallocate(ifldmiss) - endif - - if ( allocated(ifld) ) deallocate(ifld) - - !open(10,form='unformatted',recl=24180,access='direct') - !read(10,rec=1) (fldo(k),k=1,6045) - !do i =1,6045 - ! print *,i,fldo(i),fld(i),fldo(i)-fld(i) - !enddo - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/dec_jpeg2000.c b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/dec_jpeg2000.c deleted file mode 100755 index d5e3f4a614..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/dec_jpeg2000.c +++ /dev/null @@ -1,155 +0,0 @@ -#include -#include -#include -#include "jasper/jasper.h" -#define JAS_1_700_2 - - -#ifdef __64BIT__ - typedef int g2int; -#else - typedef long g2int; -#endif - -#if defined CRAY90 - #include - #define SUB_NAME DEC_JPEG2000 -#elif defined LINUXF90 - #define SUB_NAME DEC_JPEG2000 -#elif defined LINUXG95 - #define SUB_NAME dec_jpeg2000__ -#elif defined HP || defined AIX - #define SUB_NAME dec_jpeg2000 -#elif defined SGI || defined LINUX || defined VPP5000 - #define SUB_NAME dec_jpeg2000_ -#endif - - int SUB_NAME(char *injpc,g2int *bufsize,g2int *outfld) -/*$$$ SUBPROGRAM DOCUMENTATION BLOCK -* . . . . -* SUBPROGRAM: dec_jpeg2000 Decodes JPEG2000 code stream -* PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-02 -* -* ABSTRACT: This Function decodes a JPEG2000 code stream specified in the -* JPEG2000 Part-1 standard (i.e., ISO/IEC 15444-1) using JasPer -* Software version 1.500.4 (or 1.700.2) written by the University of British -* Columbia and Image Power Inc, and others. -* JasPer is available at http://www.ece.uvic.ca/~mdadams/jasper/. -* -* PROGRAM HISTORY LOG: -* 2002-12-02 Gilbert -* -* USAGE: int dec_jpeg2000(char *injpc,g2int *bufsize,g2int *outfld) -* -* INPUT ARGUMENTS: -* injpc - Input JPEG2000 code stream. -* bufsize - Length (in bytes) of the input JPEG2000 code stream. -* -* INPUT ARGUMENTS: -* outfld - Output matrix of grayscale image values. -* -* RETURN VALUES : -* 0 = Successful decode -* -3 = Error decode jpeg2000 code stream. -* -5 = decoded image had multiple color components. -* Only grayscale is expected. -* -* REMARKS: -* -* Requires JasPer Software version 1.500.4 or 1.700.2 -* -* ATTRIBUTES: -* LANGUAGE: C -* MACHINE: IBM SP -* -*$$$*/ - -{ - int ier; - g2int i,j,k,n; - jas_image_t *image=0; - jas_stream_t *jpcstream,*istream; - jas_image_cmpt_t cmpt,*pcmpt; - char *opts=0; - jas_matrix_t *data; - -// jas_init(); - -// -// Create jas_stream_t containing input JPEG200 codestream in memory. -// - - jpcstream=jas_stream_memopen(injpc,*bufsize); - -// -// Decode JPEG200 codestream into jas_image_t structure. -// - image=jpc_decode(jpcstream,opts); - if ( image == 0 ) { - printf(" jpc_decode return = %d \n",ier); - return -3; - } - - pcmpt=image->cmpts_[0]; -/* - printf(" SAGOUT DECODE:\n"); - printf(" tlx %d \n",image->tlx_); - printf(" tly %d \n",image->tly_); - printf(" brx %d \n",image->brx_); - printf(" bry %d \n",image->bry_); - printf(" numcmpts %d \n",image->numcmpts_); - printf(" maxcmpts %d \n",image->maxcmpts_); -#ifdef JAS_1_500_4 - printf(" colormodel %d \n",image->colormodel_); -#endif -#ifdef JAS_1_700_2 - printf(" colorspace %d \n",image->clrspc_); -#endif - printf(" inmem %d \n",image->inmem_); - printf(" COMPONENT:\n"); - printf(" tlx %d \n",pcmpt->tlx_); - printf(" tly %d \n",pcmpt->tly_); - printf(" hstep %d \n",pcmpt->hstep_); - printf(" vstep %d \n",pcmpt->vstep_); - printf(" width %d \n",pcmpt->width_); - printf(" height %d \n",pcmpt->height_); - printf(" prec %d \n",pcmpt->prec_); - printf(" sgnd %d \n",pcmpt->sgnd_); - printf(" cps %d \n",pcmpt->cps_); -#ifdef JAS_1_700_2 - printf(" type %d \n",pcmpt->type_); -#endif -*/ - -// Expecting jpeg2000 image to be grayscale only. -// No color components. -// - if (image->numcmpts_ != 1 ) { - printf("dec_jpeg2000: Found color image. Grayscale expected.\n"); - return (-5); - } - -// -// Create a data matrix of grayscale image values decoded from -// the jpeg2000 codestream. -// - data=jas_matrix_create(jas_image_height(image), jas_image_width(image)); - jas_image_readcmpt(image,0,0,0,jas_image_width(image), - jas_image_height(image),data); -// -// Copy data matrix to output integer array. -// - k=0; - for (i=0;iheight_;i++) - for (j=0;jwidth_;j++) - outfld[k++]=data->rows_[i][j]; -// -// Clean up JasPer work structures. -// - jas_matrix_destroy(data); - ier=jas_stream_close(jpcstream); - jas_image_destroy(image); - - return 0; - -} diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/dec_png.c b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/dec_png.c deleted file mode 100755 index 4584611d59..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/dec_png.c +++ /dev/null @@ -1,151 +0,0 @@ -#include -#include -#include -#include - -#ifdef __64BIT__ - typedef int g2int; -#else - typedef long g2int; -#endif - -#if defined CRAY90 - #include - #define SUB_NAME DEC_PNG -#elif defined LINUXF90 - #define SUB_NAME DEC_PNG -#elif defined LINUXG95 - #define SUB_NAME dec_png__ -#elif defined HP || defined AIX - #define SUB_NAME dec_png -#elif defined SGI || defined LINUX || defined VPP5000 - #define SUB_NAME dec_png_ -#endif - -struct png_stream { - unsigned char *stream_ptr; /* location to write PNG stream */ - g2int stream_len; /* number of bytes written */ -}; -typedef struct png_stream png_stream; - -void user_read_data(png_structp , png_bytep , png_uint_32 ); - -void user_read_data(png_structp png_ptr,png_bytep data, png_uint_32 length) -/* - Custom read function used so that libpng will read a PNG stream - from memory instead of a file on disk. -*/ -{ - char *ptr; - g2int offset; - png_stream *mem; - - mem=(png_stream *)png_get_io_ptr(png_ptr); - ptr=(void *)mem->stream_ptr; - offset=mem->stream_len; -/* printf("SAGrd %ld %ld %x\n",offset,length,ptr); */ - memcpy(data,ptr+offset,length); - mem->stream_len += length; -} - - - -int SUB_NAME(unsigned char *pngbuf,g2int *width,g2int *height,char *cout) -{ - int interlace,color,compres,filter,bit_depth; - g2int j,k,n,bytes,clen; - png_structp png_ptr; - png_infop info_ptr,end_info; - png_bytepp row_pointers; - png_stream read_io_ptr; - -/* check if stream is a valid PNG format */ - - if ( png_sig_cmp(pngbuf,0,8) != 0) - return (-3); - -/* create and initialize png_structs */ - - png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING, (png_voidp)NULL, - NULL, NULL); - if (!png_ptr) - return (-1); - - info_ptr = png_create_info_struct(png_ptr); - if (!info_ptr) - { - png_destroy_read_struct(&png_ptr,(png_infopp)NULL,(png_infopp)NULL); - return (-2); - } - - end_info = png_create_info_struct(png_ptr); - if (!end_info) - { - png_destroy_read_struct(&png_ptr,(png_infopp)info_ptr,(png_infopp)NULL); - return (-2); - } - -/* Set Error callback */ - - if (setjmp(png_jmpbuf(png_ptr))) - { - png_destroy_read_struct(&png_ptr, &info_ptr,&end_info); - return (-3); - } - -/* Initialize info for reading PNG stream from memory */ - - read_io_ptr.stream_ptr=(png_voidp)pngbuf; - read_io_ptr.stream_len=0; - -/* Set new custom read function */ - - png_set_read_fn(png_ptr,(voidp)&read_io_ptr,(png_rw_ptr)user_read_data); -/* png_init_io(png_ptr, fptr); */ - -/* Read and decode PNG stream */ - - png_read_png(png_ptr, info_ptr, PNG_TRANSFORM_IDENTITY, NULL); - -/* Get pointer to each row of image data */ - - row_pointers = png_get_rows(png_ptr, info_ptr); - -/* Get image info, such as size, depth, colortype, etc... */ - - /*printf("SAGT:png %d %d %d\n",info_ptr->width,info_ptr->height,info_ptr->bit_depth);*/ - (void)png_get_IHDR(png_ptr, info_ptr, (png_uint_32 *)width, (png_uint_32 *)height, - &bit_depth, &color, &interlace, &compres, &filter); - -/* Check if image was grayscale */ - -/* - if (color != PNG_COLOR_TYPE_GRAY ) { - fprintf(stderr,"dec_png: Grayscale image was expected. \n"); - } -*/ - if ( color == PNG_COLOR_TYPE_RGB ) { - bit_depth=24; - } - else if ( color == PNG_COLOR_TYPE_RGB_ALPHA ) { - bit_depth=32; - } -/* Copy image data to output string */ - - n=0; - bytes=bit_depth/8; - clen=(*width)*bytes; - for (j=0;j<*height;j++) { - for (k=0;k -#include -#include -#include "jasper/jasper.h" -#define JAS_1_700_2 - -#ifdef __64BIT__ - typedef int g2int; -#else - typedef long g2int; -#endif - -#if defined CRAY90 - #include - #define SUB_NAME ENC_JPEG2000 -#elif defined LINUXF90 - #define SUB_NAME ENC_JPEG2000 -#elif defined LINUXG95 - #define SUB_NAME enc_jpeg2000__ -#elif defined HP || defined AIX - #define SUB_NAME enc_jpeg2000 -#elif defined SGI || defined LINUX || defined VPP5000 - #define SUB_NAME enc_jpeg2000_ -#endif - -int SUB_NAME(unsigned char *cin,g2int *pwidth,g2int *pheight,g2int *pnbits, - g2int *ltype, g2int *ratio, g2int *retry, char *outjpc, - g2int *jpclen) -/*$$$ SUBPROGRAM DOCUMENTATION BLOCK -* . . . . -* SUBPROGRAM: enc_jpeg2000 Encodes JPEG2000 code stream -* PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-02 -* -* ABSTRACT: This Function encodes a grayscale image into a JPEG2000 code stream -* specified in the JPEG2000 Part-1 standard (i.e., ISO/IEC 15444-1) -* using JasPer Software version 1.500.4 (or 1.700.2 ) written by the -* University of British Columbia, Image Power Inc, and others. -* JasPer is available at http://www.ece.uvic.ca/~mdadams/jasper/. -* -* PROGRAM HISTORY LOG: -* 2002-12-02 Gilbert -* 2004-07-20 GIlbert - Added retry argument/option to allow option of -* increasing the maximum number of guard bits to the -* JPEG2000 algorithm. -* -* USAGE: int enc_jpeg2000(unsigned char *cin,g2int *pwidth,g2int *pheight, -* g2int *pnbits, g2int *ltype, g2int *ratio, -* g2int *retry, char *outjpc, g2int *jpclen) -* -* INPUT ARGUMENTS: -* cin - Packed matrix of Grayscale image values to encode. -* pwidth - Pointer to width of image -* pheight - Pointer to height of image -* pnbits - Pointer to depth (in bits) of image. i.e number of bits -* used to hold each data value -* ltype - Pointer to indicator of lossless or lossy compression -* = 1, for lossy compression -* != 1, for lossless compression -* ratio - Pointer to target compression ratio. (ratio:1) -* Used only when *ltype == 1. -* retry - Pointer to option type. -* 1 = try increasing number of guard bits -* otherwise, no additional options -* jpclen - Number of bytes allocated for new JPEG2000 code stream in -* outjpc. -* -* INPUT ARGUMENTS: -* outjpc - Output encoded JPEG2000 code stream -* -* RETURN VALUES : -* > 0 = Length in bytes of encoded JPEG2000 code stream -* -3 = Error decode jpeg2000 code stream. -* -5 = decoded image had multiple color components. -* Only grayscale is expected. -* -* REMARKS: -* -* Requires JasPer Software version 1.500.4 or 1.700.2 -* -* ATTRIBUTES: -* LANGUAGE: C -* MACHINE: IBM SP -* -*$$$*/ -{ - int ier,rwcnt; - jas_image_t image; - jas_stream_t *jpcstream,*istream; - jas_image_cmpt_t cmpt,*pcmpt; -#define MAXOPTSSIZE 1024 - char opts[MAXOPTSSIZE]; - - g2int width,height,nbits; - width=*pwidth; - height=*pheight; - nbits=*pnbits; -/* - printf(" enc_jpeg2000:width %ld\n",width); - printf(" enc_jpeg2000:height %ld\n",height); - printf(" enc_jpeg2000:nbits %ld\n",nbits); - printf(" enc_jpeg2000:jpclen %ld\n",*jpclen); -*/ -// jas_init(); - -// -// Set lossy compression options, if requested. -// - if ( *ltype != 1 ) { - opts[0]=(char)0; - } - else { - snprintf(opts,MAXOPTSSIZE,"mode=real\nrate=%f",1.0/(float)*ratio); - } - if ( *retry == 1 ) { // option to increase number of guard bits - strcat(opts,"\nnumgbits=4"); - } - //printf("SAGopts: %s\n",opts); - -// -// Initialize the JasPer image structure describing the grayscale -// image to encode into the JPEG2000 code stream. -// - image.tlx_=0; - image.tly_=0; -#ifdef JAS_1_500_4 - image.brx_=(uint_fast32_t)width; - image.bry_=(uint_fast32_t)height; -#endif -#ifdef JAS_1_700_2 - image.brx_=(jas_image_coord_t)width; - image.bry_=(jas_image_coord_t)height; -#endif - image.numcmpts_=1; - image.maxcmpts_=1; -#ifdef JAS_1_500_4 - image.colormodel_=JAS_IMAGE_CM_GRAY; /* grayscale Image */ -#endif -#ifdef JAS_1_700_2 - image.clrspc_=JAS_CLRSPC_SGRAY; /* grayscale Image */ - image.cmprof_=0; -#endif - image.inmem_=1; - - cmpt.tlx_=0; - cmpt.tly_=0; - cmpt.hstep_=1; - cmpt.vstep_=1; -#ifdef JAS_1_500_4 - cmpt.width_=(uint_fast32_t)width; - cmpt.height_=(uint_fast32_t)height; -#endif -#ifdef JAS_1_700_2 - cmpt.width_=(jas_image_coord_t)width; - cmpt.height_=(jas_image_coord_t)height; - cmpt.type_=JAS_IMAGE_CT_COLOR(JAS_CLRSPC_CHANIND_GRAY_Y); -#endif - cmpt.prec_=nbits; - cmpt.sgnd_=0; - cmpt.cps_=(nbits+7)/8; - - pcmpt=&cmpt; - image.cmpts_=&pcmpt; - -// -// Open a JasPer stream containing the input grayscale values -// - istream=jas_stream_memopen((char *)cin,height*width*cmpt.cps_); - cmpt.stream_=istream; - -// -// Open an output stream that will contain the encoded jpeg2000 -// code stream. -// - jpcstream=jas_stream_memopen(outjpc,(int)(*jpclen)); - -// -// Encode image. -// - ier=jpc_encode(&image,jpcstream,opts); - if ( ier != 0 ) { - printf(" jpc_encode return = %d \n",ier); - return -3; - } -// -// Clean up JasPer work structures. -// - rwcnt=jpcstream->rwcnt_; - ier=jas_stream_close(istream); - ier=jas_stream_close(jpcstream); -// -// Return size of jpeg2000 code stream -// - return (rwcnt); - -} - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/enc_png.c b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/enc_png.c deleted file mode 100755 index e16f5095cf..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/enc_png.c +++ /dev/null @@ -1,145 +0,0 @@ -#include -#include -#include -#include - -#ifdef __64BIT__ - typedef int g2int; -#else - typedef long g2int; -#endif - -#if defined CRAY90 - #include - #define SUB_NAME ENC_PNG -#elif defined LINUXF90 - #define SUB_NAME ENC_PNG -#elif defined LINUXG95 - #define SUB_NAME enc_png__ -#elif defined HP || defined AIX - #define SUB_NAME enc_png -#elif defined SGI || defined LINUX || defined VPP5000 - #define SUB_NAME enc_png_ -#endif - -struct png_stream { - unsigned char *stream_ptr; /* location to write PNG stream */ - g2int stream_len; /* number of bytes written */ -}; -typedef struct png_stream png_stream; - -void user_write_data(png_structp ,png_bytep , png_uint_32 ); -void user_flush_data(png_structp ); - -void user_write_data(png_structp png_ptr,png_bytep data, png_uint_32 length) -/* - Custom write function used to that libpng will write - to memory location instead of a file on disk -*/ -{ - unsigned char *ptr; - g2int offset; - png_stream *mem; - - mem=(png_stream *)png_get_io_ptr(png_ptr); - ptr=mem->stream_ptr; - offset=mem->stream_len; -/* printf("SAGwr %ld %ld %x\n",offset,length,ptr); */ - /*for (j=offset,k=0;kstream_len += length; -} - - -void user_flush_data(png_structp png_ptr) -/* - Dummy Custom flush function -*/ -{ - int *do_nothing=NULL; -} - - -int SUB_NAME(char *data,g2int *width,g2int *height,g2int *nbits,char *pngbuf) -{ - - int color_type; - g2int j,bytes,pnglen,bit_depth; - png_structp png_ptr; - png_infop info_ptr; -// png_bytep *row_pointers[*height]; - png_bytep **row_pointers; - png_stream write_io_ptr; - -/* create and initialize png_structs */ - - png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, (png_voidp)NULL, - NULL, NULL); - if (!png_ptr) - return (-1); - - info_ptr = png_create_info_struct(png_ptr); - if (!info_ptr) - { - png_destroy_write_struct(&png_ptr,(png_infopp)NULL); - return (-2); - } - -/* Set Error callback */ - - if (setjmp(png_jmpbuf(png_ptr))) - { - png_destroy_write_struct(&png_ptr, &info_ptr); - return (-3); - } - -/* Initialize info for writing PNG stream to memory */ - - write_io_ptr.stream_ptr=(png_voidp)pngbuf; - write_io_ptr.stream_len=0; - -/* Set new custom write functions */ - - png_set_write_fn(png_ptr,(voidp)&write_io_ptr,(png_rw_ptr)user_write_data, - (png_flush_ptr)user_flush_data); -/* png_init_io(png_ptr, fptr); */ -/* png_set_compression_level(png_ptr, Z_BEST_COMPRESSION); */ - -/* Set the image size, colortype, filter type, etc... */ - -/* printf("SAGTsettingIHDR %d %d %d\n",*width,*height,bit_depth); */ - bit_depth=*nbits; - color_type=PNG_COLOR_TYPE_GRAY; - if (*nbits == 24 ) { - bit_depth=8; - color_type=PNG_COLOR_TYPE_RGB; - } - else if (*nbits == 32 ) { - bit_depth=8; - color_type=PNG_COLOR_TYPE_RGB_ALPHA; - } - png_set_IHDR(png_ptr, info_ptr, *width, *height, - bit_depth, color_type, PNG_INTERLACE_NONE, - PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT); - -/* Put image data into the PNG info structure */ - - /*bytes=bit_depth/8;*/ - bytes=*nbits/8; - row_pointers=malloc((*height)*sizeof(png_bytep)); - for (j=0;j<*height;j++) row_pointers[j]=(png_bytep *)(data+(j*(*width)*bytes)); - png_set_rows(png_ptr, info_ptr, (png_bytepp)row_pointers); - -/* Do the PNG encoding, and write out PNG stream */ - - png_write_png(png_ptr, info_ptr, PNG_TRANSFORM_IDENTITY, NULL); - -/* Clean up */ - - png_destroy_write_struct(&png_ptr, &info_ptr); - free(row_pointers); - pnglen=write_io_ptr.stream_len; - return pnglen; - -} - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/g2grids.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/g2grids.f deleted file mode 100755 index dd97999a81..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/g2grids.f +++ /dev/null @@ -1,320 +0,0 @@ - module g2grids -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! MODULE: g2grids -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-04-27 -! -! ABSTRACT: This Fortran Module allows access to predefined GRIB2 Grid -! Definition Templates stored in a file. The GDTs are represented by -! a predefined number or a character abbreviation. -! -! At the first request, all the grid GDT entries in the file associated -! with input Fortran file unit number, lunit, are read into a linked list -! named gridlist. This list is searched for the requested entry. -! -! Users of this Fortran module should only call routines getgridbynum -! and getgridbyname. -! -! The format of the file scanned by routines in this module is as follows. -! Each line contains one Grid entry containing five fields, each separated -! by a colon, ":". The fields are: -! 1) - predefined grid number -! 2) - Up to an 8 character abbreviation -! 3) - Grid Definition Template number -! 4) - Number of entries in the Grid Definition Template -! 5) - A list of values for each entry in the Grid Definition Template. -! -! As an example, this is the entry for the 1x1 GFS global grid -! 3:gbl_1deg: 0:19: 0 0 0 0 0 0 0 360 181 0 0 90000000 0 48 -90000000 359000000 1000000 1000000 0 -! -! Comments can be included in the file by specifying the symbol "#" as the -! first character on the line. These lines are ignored. -! -! -! PROGRAM HISTORY LOG: -! 2004-04-27 Gilbert -! -! USAGE: use g2grids -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,parameter :: MAXTEMP=200 - - type,private :: g2grid - integer :: grid_num - integer :: gdt_num - integer :: gdt_len - integer,dimension(MAXTEMP) :: gridtmpl - character(len=8) :: cdesc - type(g2grid),pointer :: next - end type g2grid - - type(g2grid),pointer,private :: gridlist - integer :: num_grids=0 - - contains - - - integer function readgrids(lunit) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: readgrids -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28 -! -! ABSTRACT: This function reads the list of GDT entries in the file -! associated with fortran unit, lunit. All the entries are stored in a -! linked list called gridlist. -! -! PROGRAM HISTORY LOG: -! 2001-06-28 Gilbert -! -! USAGE: number=readgrids(lunit) -! INPUT ARGUMENT LIST: -! lunit - Fortran unit number associated the the GDT file. -! -! RETURNS: The number of Grid Definition Templates read in. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: lunit - - integer,parameter :: linelen=1280 - character(len=8) :: desc - character(len=linelen) :: cline - integer ient,igdtn,igdtmpl(200),igdtlen - integer :: pos1,pos2,pos3,pos4 - - type(g2grid),pointer :: gtemp - type(g2grid),pointer :: prev - integer count - - count=0 - - ! For each line in the file.... - DO - ! Read line into buffer - ! - cline(1:linelen)=' ' - read(lunit,end=999,fmt='(a)') cline - - ! - ! Skip line if commented out - ! - if (cline(1:1).eq.'#') cycle - - ! - ! find positions of delimiters, ":" - ! - pos1=index(cline,':') - cline(pos1:pos1)=';' - pos2=index(cline,':') - cline(pos2:pos2)=';' - pos3=index(cline,':') - cline(pos3:pos3)=';' - pos4=index(cline,':') - if ( pos1.eq.0 .or. pos2.eq.0 .or. pos3.eq.0 .or. - & pos4.eq.0) cycle - - ! - ! Read each of the five fields. - ! - read(cline(1:pos1-1),*) ient - read(cline(pos1+1:pos2-1),*) desc - read(cline(pos2+1:pos3-1),*) igdtn - read(cline(pos3+1:pos4-1),*) igdtlen - read(cline(pos4+1:linelen),*) (igdtmpl(j),j=1,igdtlen) - - ! - ! Allocate new type(g2grid) variable to store the GDT - ! - allocate(gtemp,stat=iom) - count=count+1 - gtemp%grid_num=ient - gtemp%gdt_num=igdtn - gtemp%gdt_len=igdtlen - gtemp%gridtmpl=igdtmpl - gtemp%cdesc=desc - nullify(gtemp%next) ! defines end of linked list. - if ( count .eq. 1 ) then - gridlist => gtemp - else ! make sure previous entry in list - prev%next => gtemp ! points to the new entry, - endif - prev => gtemp - - enddo - - 999 readgrids=count - return - - end function - - - subroutine getgridbynum(lunit,number,igdtn,igdtmpl,iret) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getgridbynum -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-04-26 -! -! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit -! for a Grid Definition Template assigned to the requested number. -! The input file format is described at the top of this module. -! -! PROGRAM HISTORY LOG: -! 2004-04-26 Gilbert -! -! USAGE: CALL getgridbynum(lunit,number,igdtn,igdtmpl,iret) -! INPUT ARGUMENT LIST: -! lunit - Unit number of file containing Grid definitions -! number - Grid number of the requested Grid definition -! -! OUTPUT ARGUMENT LIST: -! igdtn - NN, indicating the number of the Grid Definition -! Template 3.NN -! igdtmpl()- An array containing the values of each entry in -! the Grid Definition Template. -! iret - Error return code. -! 0 = no error -! -1 = Undefined Grid number. -! 3 = Could not read any grids from file. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: lunit,number - integer,intent(out) :: igdtn,igdtmpl(*),iret - - type(g2grid),pointer :: tempgrid - - iret=0 - igdtn=-1 - !igdtmpl=0 - - ! - ! If no grids in list, try reading them from the file. - ! - if ( num_grids .eq. 0 ) then - num_grids=readgrids(lunit) - endif - - if ( num_grids .eq. 0 ) then - iret=3 ! problem reading file - return - endif - - tempgrid => gridlist - - ! - ! Search through list - ! - do while ( associated(tempgrid) ) - if ( number .eq. tempgrid%grid_num ) then - igdtn=tempgrid%gdt_num - igdtmpl(1:tempgrid%gdt_len)= - & tempgrid%gridtmpl(1:tempgrid%gdt_len) - return - else - tempgrid => tempgrid%next - endif - enddo - - iret=-1 - return - - end subroutine - - - subroutine getgridbyname(lunit,name,igdtn,igdtmpl,iret) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getgridbyname -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-04-26 -! -! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit -! for a Grid Definition Template assigned to the requested name. -! The input file format is described at the top of this module. -! -! PROGRAM HISTORY LOG: -! 2004-04-26 Gilbert -! -! USAGE: CALL getgridbyname(lunit,name,igdtn,igdtmpl,iret) -! INPUT ARGUMENT LIST: -! lunit - Unit number of file containing Grid definitions -! name - Grid name of the requested Grid definition -! -! OUTPUT ARGUMENT LIST: -! igdtn - NN, indicating the number of the Grid Definition -! Template 3.NN -! igdtmpl()- An array containing the values of each entry in -! the Grid Definition Template. -! iret - Error return code. -! 0 = no error -! -1 = Undefined Grid number. -! 3 = Could not read any grids from file. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: lunit - character(len=8),intent(in) :: name - integer,intent(out) :: igdtn,igdtmpl(*),iret - - type(g2grid),pointer :: tempgrid - - iret=0 - igdtn=-1 - !igdtmpl=0 - - ! - ! If no grids in list, try reading them from the file. - ! - if ( num_grids .eq. 0 ) then - num_grids=readgrids(lunit) - endif - - if ( num_grids .eq. 0 ) then - iret=3 ! problem reading file - return - endif - - tempgrid => gridlist - - ! - ! Search through list - ! - do while ( associated(tempgrid) ) - if ( name .eq. tempgrid%cdesc ) then - igdtn=tempgrid%gdt_num - igdtmpl(1:tempgrid%gdt_len)= - & tempgrid%gridtmpl(1:tempgrid%gdt_len) - return - else - tempgrid => tempgrid%next - endif - enddo - - iret=-1 - return - - end subroutine - - - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/g2grids.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/g2grids.mod deleted file mode 100644 index b0b7b41cf0..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/g2grids.mod +++ /dev/null @@ -1,53 +0,0 @@ -GFORTRAN module created from g2grids.f on Mon Nov 16 16:43:03 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'g2grids' 'g2grids' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) ( -UNKNOWN 0 ()) 0 0 () () 0 () ()) -3 'getgridbyname' 'g2grids' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL SUBROUTINE) (UNKNOWN 0 ()) 4 0 (5 6 7 8 9) () 0 () ()) -10 'getgridbynum' 'g2grids' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL SUBROUTINE) (UNKNOWN 0 ()) 11 0 (12 13 14 15 16) () 0 () ()) -17 'readgrids' 'g2grids' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL -FUNCTION) (INTEGER 4 ()) 18 0 (19) () 17 () ()) -20 'num_grids' 'g2grids' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () () 0 () ()) -21 'maxtemp' 'g2grids' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '200') () 0 () ()) -12 'lunit' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -14 'igdtn' '' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -15 'igdtmpl' '' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) -(INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -7 'igdtn' '' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -8 'igdtmpl' '' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -6 'name' '' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (CHARACTER 1 (( -CONSTANT (INTEGER 4 ()) 0 '8'))) 0 0 () () 0 () ()) -16 'iret' '' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -13 'number' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -19 'lunit' '' 18 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -9 'iret' '' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -5 'lunit' '' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -) - -('getgridbynum' 0 10 'getgridbyname' 0 3 'g2grids' 0 2 'maxtemp' 0 21 -'num_grids' 0 20 'readgrids' 0 17) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gb_info.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gb_info.f deleted file mode 100755 index b346eb0fa9..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gb_info.f +++ /dev/null @@ -1,194 +0,0 @@ - subroutine gb_info(cgrib,lcgrib,listsec0,listsec1, - & numfields,numlocal,maxlocal,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gb_info -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25 -! -! ABSTRACT: This subroutine searches through a GRIB2 message and -! returns the number of gridded fields found in the message and -! the number (and maximum size) of Local Use Sections. -! Also various checks are performed -! to see if the message is a valid GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-25 Gilbert -! -! USAGE: CALL gb_info(cgrib,lcgrib,listsec0,listsec1, -! & numfields,numlocal,maxlocal,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message in array cgrib. -! -! OUTPUT ARGUMENT LIST: -! listsec0 - Contains information decoded from GRIB Indicator Section 0. -! Must be dimensioned >= 2. -! listsec0(1)=Discipline-GRIB Master Table Number -! (see Code Table 0.0) -! listsec0(2)=GRIB Edition Number (currently 2) -! listsec0(3)=Length of GRIB message -! listsec1 - Contains information read from GRIB Identification Section 1. -! Must be dimensioned >= 13. -! listsec1(1)=Id of orginating centre (Common Code Table C-1) -! listsec1(2)=Id of orginating sub-centre (local table) -! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0) -! listsec1(4)=GRIB Local Tables Version Number -! listsec1(5)=Significance of Reference Time (Code Table 1.1) -! listsec1(6)=Reference Time - Year (4 digits) -! listsec1(7)=Reference Time - Month -! listsec1(8)=Reference Time - Day -! listsec1(9)=Reference Time - Hour -! listsec1(10)=Reference Time - Minute -! listsec1(11)=Reference Time - Second -! listsec1(12)=Production status of data (Code Table 1.2) -! listsec1(13)=Type of processed data (Code Table 1.3) -! numfields- The number of gridded fieldse found in the GRIB message. -! numlocal - The number of Local Use Sections ( Section 2 ) found in -! the GRIB message. -! maxlocal- The size of the largest Local Use Section ( Section 2 ). -! Can be used to ensure that the return array passed -! to subroutine getlocal is dimensioned large enough. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = Could not find Section 1, where expected. -! 4 = End string "7777" found, but not where expected. -! 5 = End string "7777" not found at end of message. -! 6 = Invalid section number found. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(out) :: listsec0(3),listsec1(13) - integer,intent(out) :: numlocal,numfields,maxlocal,ierr - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4) :: ctemp - integer,parameter :: zero=0,one=1 - integer,parameter :: mapsec1len=13 - integer,parameter :: - & mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /) - integer iofst,ibeg,istart - - ierr=0 - numlocal=0 - numfields=0 - maxlocal=0 -! -! Check for beginning of GRIB message in the first 100 bytes -! - istart=0 - do j=1,100 - ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3) - if (ctemp.eq.grib ) then - istart=j - exit - endif - enddo - if (istart.eq.0) then - print *,'gb_info: Beginning characters GRIB not found.' - ierr=1 - return - endif -! -! Unpack Section 0 - Indicator Section -! - iofst=8*(istart+5) - call gbyte(cgrib,listsec0(1),iofst,8) ! Discipline - iofst=iofst+8 - call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number - iofst=iofst+8 - iofst=iofst+32 - call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message - iofst=iofst+32 - listsec0(3)=lengrib - lensec0=16 - ipos=istart+lensec0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'gb_info: can only decode GRIB edition 2.' - ierr=2 - return - endif -! -! Unpack Section 1 - Identification Section -! - call gbyte(cgrib,lensec1,iofst,32) ! Length of Section 1 - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Section number ( 1 ) - iofst=iofst+8 - if (isecnum.ne.1) then - print *,'gb_info: Could not find section 1.' - ierr=3 - return - endif - ! - ! Unpack each input value in array listsec1 into the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapsec1. - ! - do i=1,mapsec1len - nbits=mapsec1(i)*8 - call gbyte(cgrib,listsec1(i),iofst,nbits) - iofst=iofst+nbits - enddo - ipos=ipos+lensec1 -! -! Loop through the remaining sections to see if they are valid. -! Also count the number of times Section 2 -! and Section 4 appear. -! - do - ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3) - if (ctemp.eq.c7777 ) then - ipos=ipos+4 - if (ipos.ne.(istart+lengrib)) then - print *,'gb_info: "7777" found, but not where expected.' - ierr=4 - return - endif - exit - endif - iofst=(ipos-1)*8 - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section number - iofst=iofst+8 - ipos=ipos+lensec ! Update beginning of section pointer - if (ipos.gt.(istart+lengrib)) then - print *,'gb_info: "7777" not found at end of GRIB message.' - ierr=5 - return - endif - if ( isecnum.ge.2.AND.isecnum.le.7 ) then - if (isecnum.eq.2) then ! Local Section 2 - ! increment counter for total number of local sections found - numlocal=numlocal+1 - lenposs=lensec-5 - if ( lenposs.gt.maxlocal ) maxlocal=lenposs - elseif (isecnum.eq.4) then - ! increment counter for total number of fields found - numfields=numfields+1 - endif - else - print *,'gb_info: Invalid section number found in GRIB', - & ' message: ',isecnum - ierr=6 - return - endif - - enddo - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gbytesc.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gbytesc.f deleted file mode 100755 index 1e60d819d3..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gbytesc.f +++ /dev/null @@ -1,127 +0,0 @@ - SUBROUTINE GBYTE(IN,IOUT,ISKIP,NBYTE) - character*1 in(*) - integer iout(*) - CALL GBYTES(IN,IOUT,ISKIP,NBYTE,0,1) - RETURN - END - - SUBROUTINE SBYTE(OUT,IN,ISKIP,NBYTE) - character*1 out(*) - integer in(*) - CALL SBYTES(OUT,IN,ISKIP,NBYTE,0,1) - RETURN - END - - SUBROUTINE GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N) -C Get bytes - unpack bits: Extract arbitrary size values from a -C packed bit string, right justifying each value in the unpacked -C array. -C IN = character*1 array input -C IOUT = unpacked array output -C ISKIP = initial number of bits to skip -C NBYTE = number of bits to take -C NSKIP = additional number of bits to skip on each iteration -C N = number of iterations -C v1.1 -C - character*1 in(*) - integer iout(*) - integer ones(8), tbit, bitcnt - save ones - data ones/1,3,7,15,31,63,127,255/ - -c nbit is the start position of the field in bits - nbit = iskip - do i = 1, n - bitcnt = nbyte - index=nbit/8+1 - ibit=mod(nbit,8) - nbit = nbit + nbyte + nskip - -c first byte - tbit = min(bitcnt,8-ibit) - itmp = iand(mova2i(in(index)),ones(8-ibit)) - if (tbit.ne.8-ibit) itmp = ishft(itmp,tbit-8+ibit) - index = index + 1 - bitcnt = bitcnt - tbit - -c now transfer whole bytes - do while (bitcnt.ge.8) - itmp = ior(ishft(itmp,8),mova2i(in(index))) - bitcnt = bitcnt - 8 - index = index + 1 - enddo - -c get data from last byte - if (bitcnt.gt.0) then - itmp = ior(ishft(itmp,bitcnt),iand(ishft(mova2i(in(index)), - 1 -(8-bitcnt)),ones(bitcnt))) - endif - - iout(i) = itmp - enddo - - RETURN - END - - SUBROUTINE SBYTES(OUT,IN,ISKIP,NBYTE,NSKIP,N) -C Store bytes - pack bits: Put arbitrary size values into a -C packed bit string, taking the low order bits from each value -C in the unpacked array. -C IOUT = packed array output -C IN = unpacked array input -C ISKIP = initial number of bits to skip -C NBYTE = number of bits to pack -C NSKIP = additional number of bits to skip on each iteration -C N = number of iterations -C v1.1 -C - character*1 out(*) - integer in(N), bitcnt, ones(8), tbit - save ones - data ones/ 1, 3, 7, 15, 31, 63,127,255/ - -c number bits from zero to ... -c nbit is the last bit of the field to be filled - - nbit = iskip + nbyte - 1 - do i = 1, n - itmp = in(i) - bitcnt = nbyte - index=nbit/8+1 - ibit=mod(nbit,8) - nbit = nbit + nbyte + nskip - -c make byte aligned - if (ibit.ne.7) then - tbit = min(bitcnt,ibit+1) - imask = ishft(ones(tbit),7-ibit) - itmp2 = iand(ishft(itmp,7-ibit),imask) - itmp3 = iand(mova2i(out(index)), 255-imask) - out(index) = char(ior(itmp2,itmp3)) - bitcnt = bitcnt - tbit - itmp = ishft(itmp, -tbit) - index = index - 1 - endif - -c now byte aligned - -c do by bytes - do while (bitcnt.ge.8) - out(index) = char(iand(itmp,255)) - itmp = ishft(itmp,-8) - bitcnt = bitcnt - 8 - index = index - 1 - enddo - -c do last byte - - if (bitcnt.gt.0) then - itmp2 = iand(itmp,ones(bitcnt)) - itmp3 = iand(mova2i(out(index)), 255-ones(bitcnt)) - out(index) = char(ior(itmp2,itmp3)) - endif - enddo - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gdt2gds.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gdt2gds.f deleted file mode 100755 index 19fd845e36..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gdt2gds.f +++ /dev/null @@ -1,362 +0,0 @@ - subroutine gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds, - & igrid,iret) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: gdt2gds -C PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-17 -C -C ABSTRACT: This routine converts grid information from a GRIB2 -C Grid Description Section as well as its -C Grid Definition Template to GRIB1 GDS info. In addition, -C a check is made to determine if the grid is an NCEP -C predefined grid. -C -C PROGRAM HISTORY LOG: -C 2003-06-17 Gilbert -C 2004-04-27 Gilbert - Added support for gaussian grids. -C 2007-04-16 Vuong - Added Curvilinear Orthogonal grids. -C 2007-05-29 Vuong - Added Rotate Lat/Lon E-grid (203) -C -C USAGE: CALL gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds,igrid,iret) -C INPUT ARGUMENT LIST: -C igds() - Contains information read from the appropriate GRIB Grid -C Definition Section 3 for the field being returned. -C Must be dimensioned >= 5. -C igds(1)=Source of grid definition (see Code Table 3.0) -C igds(2)=Number of grid points in the defined grid. -C igds(3)=Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C igds(4)=Interpretation of list for optional points -C definition. (Code Table 3.11) -C igds(5)=Grid Definition Template Number (Code Table 3.1) -C igdstmpl() - Grid Definition Template values for GDT 3.igds(5) -C idefnum - The number of entries in array ideflist. -C i.e. number of rows ( or columns ) -C for which optional grid points are defined. -C ideflist() - Optional integer array containing -C the number of grid points contained in each row (or column). -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C kgds() - GRIB1 GDS as described in w3fi63 format. -C igrid - NCEP predefined GRIB1 grid number -C set to 255, if not NCEP grid -C iret - Error return value: -C 0 = Successful -C 1 = Unrecognized GRIB2 GDT number 3.igds(5) -C -C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION -C -C ATTRIBUTES: -C LANGUAGE: INDICATE EXTENSIONS, COMPILER OPTIONS -C MACHINE: IBM SP -C -C$$$ -! - integer,intent(in) :: idefnum - integer,intent(in) :: igds(*),igdstmpl(*),ideflist(*) - integer,intent(out) :: kgds(*),igrid,iret - - integer :: kgds72(200),kgds71(200),idum(200),jdum(200) - - iret=0 - if (igds(5).eq.0) then ! Lat/Lon grid - kgds(1)=0 - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(12)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(13)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(15)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(16)/1000 ! Long of last grid point - kgds(9)=igdstmpl(17)/1000 ! Di - kgds(10)=igdstmpl(18)/1000 ! Dj - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - ! - ! Process irreg grid stuff, if necessary - ! - if ( idefnum.ne.0 ) then - if ( igdstmpl(8).eq.-1 ) then - kgds(2)=65535 - kgds(9)=65535 - endif - if ( igdstmpl(9).eq.-1 ) then - kgds(3)=65535 - kgds(10)=65535 - endif - kgds(19)=0 - kgds(20)=33 - if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43 - kgds(21)=igds(2) ! num of grid points - do j=1,idefnum - kgds(21+j)=ideflist(j) - enddo - endif - elseif (igds(5).eq.10) then ! Mercator grid - kgds(1)=1 ! Grid Definition Template number - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(10)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(11)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(14)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(15)/1000 ! Long of last grid point - kgds(9)=igdstmpl(13)/1000 ! Lat intersects earth - kgds(10)=0 - kgds(11)=igdstmpl(16) ! Scanning mode - kgds(12)=igdstmpl(18)/1000 ! Di - kgds(13)=igdstmpl(19)/1000 ! Dj - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.30) then ! Lambert Conformal Grid - kgds(1)=3 - kgds(2)=igdstmpl(8) ! Nx - kgds(3)=igdstmpl(9) ! Ny - kgds(4)=igdstmpl(10)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(11)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(14)/1000 ! Lon of orientation - kgds(8)=igdstmpl(15)/1000 ! Dx - kgds(9)=igdstmpl(16)/1000 ! Dy - kgds(10)=igdstmpl(17) ! Projection Center Flag - kgds(11)=igdstmpl(18) ! Scanning mode - kgds(12)=igdstmpl(19)/1000 ! Lat in 1 - kgds(13)=igdstmpl(20)/1000 ! Lat in 2 - kgds(14)=igdstmpl(21)/1000 ! Lat of S. Pole of projection - kgds(15)=igdstmpl(22)/1000 ! Lon of S. Pole of projection - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.40) then ! Gaussian Lat/Lon grid - kgds(1)=4 - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(12)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(13)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(15)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(16)/1000 ! Long of last grid point - kgds(9)=igdstmpl(17)/1000 ! Di - kgds(10)=igdstmpl(18) ! N - Number of parallels - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.20) then ! Polar Stereographic Grid - kgds(1)=5 - kgds(2)=igdstmpl(8) ! Nx - kgds(3)=igdstmpl(9) ! Ny - kgds(4)=igdstmpl(10)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(11)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(12),4).OR.btest(igdstmpl(12),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(12),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(14)/1000 ! Lon of orientation - kgds(8)=igdstmpl(15)/1000 ! Dx - kgds(9)=igdstmpl(16)/1000 ! Dy - kgds(10)=igdstmpl(17) ! Projection Center Flag - kgds(11)=igdstmpl(18) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - elseif (igds(5).eq.204) then ! Curvilinear Orthogonal - kgds(1)=204 - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=0 - kgds(5)=0 - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=0 - kgds(8)=0 - kgds(9)=0 - kgds(10)=0 - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - ! - ! Process irreg grid stuff, if necessary - ! - if ( idefnum.ne.0 ) then - if ( igdstmpl(8).eq.-1 ) then - kgds(2)=65535 - kgds(9)=65535 - endif - if ( igdstmpl(9).eq.-1 ) then - kgds(3)=65535 - kgds(10)=65535 - endif - kgds(19)=0 - kgds(20)=33 - if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43 - kgds(21)=igds(2) ! num of grid points - do j=1,idefnum - kgds(21+j)=ideflist(j) - enddo - endif - elseif (igds(5).eq.32768) then ! Rotate Lat/Lon grid - kgds(1)=0 ! Arakawa Staggerred E/B grid - kgds(2)=igdstmpl(8) ! Ni - kgds(3)=igdstmpl(9) ! Nj - kgds(4)=igdstmpl(12)/1000 ! Lat of 1st grid point - kgds(5)=igdstmpl(13)/1000 ! Long of 1st grid point - kgds(6)=0 ! resolution and component flags - if (igdstmpl(1)==2 ) kgds(6)=64 - if ( btest(igdstmpl(14),4).OR.btest(igdstmpl(14),5) ) - & kgds(6)=kgds(6)+128 - if ( btest(igdstmpl(14),3) ) kgds(6)=kgds(6)+8 - kgds(7)=igdstmpl(15)/1000 ! Lat of last grid point - kgds(8)=igdstmpl(16)/1000 ! Long of last grid point - kgds(9)=igdstmpl(17)/1000 ! Di - kgds(10)=igdstmpl(18)/1000 ! Dj - kgds(11)=igdstmpl(19) ! Scanning mode - kgds(12)=0 - kgds(13)=0 - kgds(14)=0 - kgds(15)=0 - kgds(16)=0 - kgds(17)=0 - kgds(18)=0 - kgds(19)=0 - kgds(20)=255 - kgds(21)=0 - kgds(22)=0 - ! - ! Process irreg grid stuff, if necessary - ! - if ( idefnum.ne.0 ) then - if ( igdstmpl(8).eq.-1 ) then - kgds(2)=65535 - kgds(9)=65535 - endif - if ( igdstmpl(9).eq.-1 ) then - kgds(3)=65535 - kgds(10)=65535 - endif - kgds(19)=0 - kgds(20)=33 - if ( kgds(1).eq.1.OR.kgds(1).eq.3 ) kgds(20)=43 - kgds(21)=igds(2) ! num of grid points - do j=1,idefnum - kgds(21+j)=ideflist(j) - enddo - endif - else - Print *,'gdt2gds: Unrecognized GRIB2 GDT = 3.',igds(5) - iret=1 - kgds(1:22)=0 - return - endif -! -! Can we determine NCEP grid number ? -! - igrid=255 - do j=254,1,-1 - !do j=225,225 - kgds71=0 - kgds72=0 - call w3fi71(j,kgds71,ierr) - if ( ierr.ne.0 ) cycle - ! convert W to E for longitudes - if ( kgds71(3).eq.0 ) then ! lat/lon - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10) - elseif ( kgds71(3).eq.1 ) then ! mercator - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10) - elseif ( kgds71(3).eq.3 ) then ! lambert conformal - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(9).lt.0 ) kgds71(9)=360000+kgds71(9) - if ( kgds71(18).lt.0 ) kgds71(18)=360000+kgds71(18) - elseif ( kgds71(3).eq.4 ) then ! Guassian lat/lon - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(10).lt.0 ) kgds71(10)=360000+kgds71(10) - elseif ( kgds71(3).eq.5 ) then ! polar stereographic - if ( kgds71(7).lt.0 ) kgds71(7)=360000+kgds71(7) - if ( kgds71(9).lt.0 ) kgds71(9)=360000+kgds71(9) - endif - call r63w72(idum,kgds,jdum,kgds72) - if ( kgds72(3).eq.3 ) kgds72(14)=0 ! lambert conformal fix - if ( kgds72(3).eq.1 ) kgds72(15:18)=0 ! mercator fix - if ( kgds72(3).eq.5 ) kgds72(14:18)=0 ! polar str fix -c print *,' kgds71(',j,')= ', kgds71(1:30) -c print *,' kgds72 = ', kgds72(1:30) - if ( all(kgds71.eq.kgds72) ) then - igrid=j - return - endif - enddo - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getdim.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getdim.f deleted file mode 100755 index 2e66068a14..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getdim.f +++ /dev/null @@ -1,102 +0,0 @@ - subroutine getdim(csec3,lcsec3,width,height,iscan) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getdim -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-11 -! -! ABSTRACT: This subroutine returns the dimensions and scanning mode of -! a grid definition packed in GRIB2 Grid Definition Section 3 format. -! -! PROGRAM HISTORY LOG: -! 2002-12-11 Gilbert -! -! USAGE: CALL getdim(csec3,lcsec3,width,height,iscan) -! INPUT ARGUMENT LIST: -! csec3 - Character array that contains the packed GRIB2 GDS -! lcsec3 - Length (in octets) of section 3 -! -! OUTPUT ARGUMENT LIST: -! width - x (or i) dimension of the grid. -! height - y (or j) dimension of the grid. -! iscan - Scanning mode ( see Code Table 3.4 ) -! -! REMARKS: Returns width and height set to zero, if grid template -! not recognized. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ -! use grib_mod - - character(len=1),intent(in) :: csec3(*) - integer,intent(in) :: lcsec3 - integer,intent(out) :: width,height,iscan - - integer,pointer,dimension(:) :: igdstmpl,list_opt - integer :: igds(5) - integer iofst,igdtlen,num_opt,jerr - - interface - subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, - & mapgridlen,ideflist,idefnum,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: igdstmpl,ideflist - integer,intent(out) :: igds(5) - integer,intent(out) :: ierr,idefnum - end subroutine gf_unpack3 - end interface - - nullify(igdstmpl,list_opt) - ! - iofst=0 ! set offset to beginning of section - call gf_unpack3(csec3,lcsec3,iofst,igds,igdstmpl, - & igdtlen,list_opt,num_opt,jerr) - if (jerr.eq.0) then - selectcase( igds(5) ) ! Template number - case (0:3) ! Lat/Lon - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(19) - case (10) ! Mercator - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(16) - case (20) ! Polar Stereographic - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(18) - case (30) ! Lambert Conformal - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(18) - case (40:43) ! Gaussian - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(19) - case (90) ! Space View/Orthographic - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(17) - case (110) ! Equatorial Azimuthal - width=igdstmpl(8) - height=igdstmpl(9) - iscan=igdstmpl(16) - case default - width=0 - height=0 - iscan=0 - end select - else - width=0 - height=0 - endif - ! - if (associated(igdstmpl)) deallocate(igdstmpl) - if (associated(list_opt)) deallocate(list_opt) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getfield.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getfield.f deleted file mode 100755 index 273d8dbb16..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getfield.f +++ /dev/null @@ -1,823 +0,0 @@ - subroutine getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen, - & ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen, - & coordlist,numcoord,ndpts,idrsnum,idrstmpl, - & idrslen,ibmap,bmap,fld,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getfield -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine returns the Grid Definition, Product Definition, -! Bit-map ( if applicable ), and the unpacked data for a given data -! field. Since there can be multiple data fields packed into a GRIB2 -! message, the calling routine indicates which field is being requested -! with the ifldnum argument. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen, -! & ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen, -! & coordlist,numcoord,ndpts,idrsnum,idrstmpl, -! & idrslen,ibmap,bmap,fld,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! ifldnum - Specifies which field in the GRIB2 message to return. -! -! OUTPUT ARGUMENT LIST: -! igds - Contains information read from the appropriate GRIB Grid -! Definition Section 3 for the field being returned. -! Must be dimensioned >= 5. -! igds(1)=Source of grid definition (see Code Table 3.0) -! igds(2)=Number of grid points in the defined grid. -! igds(3)=Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! igds(4)=Interpretation of list for optional points -! definition. (Code Table 3.11) -! igds(5)=Grid Definition Template Number (Code Table 3.1) -! igdstmpl - Contains the data values for the specified Grid Definition -! Template ( NN=igds(5) ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Defintion Template 3.NN -! A safe dimension for this array can be obtained in advance -! from maxvals(2), which is returned from subroutine gribinfo. -! igdslen - Number of elements in igdstmpl(). i.e. number of entries -! in Grid Defintion Template 3.NN ( NN=igds(5) ). -! ideflist - (Used if igds(3) .ne. 0) This array contains the -! number of grid points contained in each row ( or column ). -! (part of Section 3) -! A safe dimension for this array can be obtained in advance -! from maxvals(3), which is returned from subroutine gribinfo. -! idefnum - (Used if igds(3) .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. -! ipdsnum - Product Definition Template Number ( see Code Table 4.0) -! ipdstmpl - Contains the data values for the specified Product Definition -! Template ( N=ipdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 4.N -! A safe dimension for this array can be obtained in advance -! from maxvals(4), which is returned from subroutine gribinfo. -! ipdslen - Number of elements in ipdstmpl(). i.e. number of entries -! in Product Defintion Template 4.N ( N=ipdsnum ). -! coordlist- Array containg floating point values intended to document -! the vertical discretisation associated to model data -! on hybrid coordinate vertical levels. (part of Section 4) -! The dimension of this array can be obtained in advance -! from maxvals(5), which is returned from subroutine gribinfo. -! numcoord - number of values in array coordlist. -! ndpts - Number of data points unpacked and returned. -! idrsnum - Data Representation Template Number ( see Code Table 5.0) -! idrstmpl - Contains the data values for the specified Data Representation -! Template ( N=idrsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 5.N -! A safe dimension for this array can be obtained in advance -! from maxvals(6), which is returned from subroutine gribinfo. -! idrslen - Number of elements in idrstmpl(). i.e. number of entries -! in Data Representation Template 5.N ( N=idrsnum ). -! ibmap - Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! bmap() - Logical*1 array containing decoded bitmap. ( if ibmap=0 ) -! The dimension of this array can be obtained in advance -! from maxvals(7), which is returned from subroutine gribinfo. -! fld() - Array of ndpts unpacked data points. -! A safe dimension for this array can be obtained in advance -! from maxvals(7), which is returned from subroutine gribinfo. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = The data field request number was not positive. -! 4 = End string "7777" found, but not where expected. -! 6 = GRIB message did not contain the requested number of -! data fields. -! 7 = End string "7777" not found at end of message. -! 9 = Data Representation Template 5.NN not yet implemented. -! 10 = Error unpacking Section 3. -! 11 = Error unpacking Section 4. -! 12 = Error unpacking Section 5. -! 13 = Error unpacking Section 6. -! 14 = Error unpacking Section 7. -! -! REMARKS: Note that subroutine gribinfo can be used to first determine -! how many data fields exist in a given GRIB message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ifldnum - integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*) - integer,intent(out) :: ipdsnum,ipdstmpl(*) - integer,intent(out) :: idrsnum,idrstmpl(*) - integer,intent(out) :: ndpts,ibmap,idefnum,numcoord - integer,intent(out) :: ierr - logical*1,intent(out) :: bmap(*) - real,intent(out) :: fld(*),coordlist(*) - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4) :: ctemp - integer:: listsec0(2) - integer iofst,ibeg,istart - integer(4) :: ieee - logical have3,have4,have5,have6,have7 - - have3=.false. - have4=.false. - have5=.false. - have6=.false. - have7=.false. - ierr=0 - numfld=0 -! -! Check for valid request number -! - if (ifldnum.le.0) then - print *,'getfield: Request for field number must be positive.' - ierr=3 - return - endif -! -! Check for beginning of GRIB message in the first 100 bytes -! - istart=0 - do j=1,100 - ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3) - if (ctemp.eq.grib ) then - istart=j - exit - endif - enddo - if (istart.eq.0) then - print *,'getfield: Beginning characters GRIB not found.' - ierr=1 - return - endif -! -! Unpack Section 0 - Indicator Section -! - iofst=8*(istart+5) - call gbyte(cgrib,listsec0(1),iofst,8) ! Discipline - iofst=iofst+8 - call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number - iofst=iofst+8 - iofst=iofst+32 - call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message - iofst=iofst+32 - lensec0=16 - ipos=istart+lensec0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'getfield: can only decode GRIB edition 2.' - ierr=2 - return - endif -! -! Loop through the remaining sections keeping track of the -! length of each. Also keep the latest Grid Definition Section info. -! Unpack the requested field number. -! - do - ! Check to see if we are at end of GRIB message - ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3) - if (ctemp.eq.c7777 ) then - ipos=ipos+4 - ! If end of GRIB message not where expected, issue error - if (ipos.ne.(istart+lengrib)) then - print *,'getfield: "7777" found, but not where expected.' - ierr=4 - return - endif - exit - endif - ! Get length of Section and Section number - iofst=(ipos-1)*8 - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section number - iofst=iofst+8 - !print *,' lensec= ',lensec,' secnum= ',isecnum - ! - ! If found Section 3, unpack the GDS info using the - ! appropriate template. Save in case this is the latest - ! grid before the requested field. - ! - if (isecnum.eq.3) then - iofst=iofst-40 ! reset offset to beginning of section - call unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,igdslen, - & ideflist,idefnum,jerr) - if (jerr.eq.0) then - have3=.true. - else - ierr=10 - return - endif - endif - ! - ! If found Section 4, check to see if this field is the - ! one requested. - ! - if (isecnum.eq.4) then - numfld=numfld+1 - if (numfld.eq.ifldnum) then - iofst=iofst-40 ! reset offset to beginning of section - call unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,ipdslen, - & coordlist,numcoord,jerr) - if (jerr.eq.0) then - have4=.true. - else - ierr=11 - return - endif - endif - endif - ! - ! If found Section 5, check to see if this field is the - ! one requested. - ! - if ((isecnum.eq.5).and.(numfld.eq.ifldnum)) then - iofst=iofst-40 ! reset offset to beginning of section - call unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl, - & idrslen,jerr) - if (jerr.eq.0) then - have5=.true. - else - ierr=12 - return - endif - endif - ! - ! If found Section 6, Unpack bitmap. - ! Save in case this is the latest - ! bitmap before the requested field. - ! - if (isecnum.eq.6) then - iofst=iofst-40 ! reset offset to beginning of section - call unpack6(cgrib,lcgrib,iofst,igds(2),ibmap,bmap,jerr) - if (jerr.eq.0) then - have6=.true. - else - ierr=13 - return - endif - endif - ! - ! If found Section 7, check to see if this field is the - ! one requested. - ! - if ((isecnum.eq.7).and.(numfld.eq.ifldnum)) then - if (idrsnum.eq.0) then - call simunpack(cgrib(ipos+5),lensec-6,idrstmpl,ndpts,fld) - have7=.true. - elseif (idrsnum.eq.2.or.idrsnum.eq.3) then - call comunpack(cgrib(ipos+5),lensec-6,lensec,idrsnum, - & idrstmpl,ndpts,fld,ier) - if ( ier .ne. 0 ) then - ierr=14 - return - endif - have7=.true. - elseif (idrsnum.eq.50) then - call simunpack(cgrib(ipos+5),lensec-6,idrstmpl,ndpts-1, - & fld(2)) - ieee=idrstmpl(5) - call rdieee(ieee,fld(1),1) - have7=.true. - else - print *,'getfield: Data Representation Template ',idrsnum, - & ' not yet implemented.' - ierr=9 - return - endif - endif - ! - ! Check to see if we read pass the end of the GRIB - ! message and missed the terminator string '7777'. - ! - ipos=ipos+lensec ! Update beginning of section pointer - if (ipos.gt.(istart+lengrib)) then - print *,'getfield: "7777" not found at end of GRIB message.' - ierr=7 - return - endif - - if (have3.and.have4.and.have5.and.have6.and.have7) return - - enddo - -! -! If exited from above loop, the end of the GRIB message was reached -! before the requested field was found. -! - print *,'getfield: GRIB message contained ',numlocal, - & ' different fields.' - print *,'getfield: The request was for the ',ifldnum, - & ' field.' - ierr=6 - - return - end - - - subroutine unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, - & mapgridlen,ideflist,idefnum,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: unpack3 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl, -! & mapgridlen,ideflist,idefnum,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 3. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 3, returned. -! igds - Contains information read from the appropriate GRIB Grid -! Definition Section 3 for the field being returned. -! Must be dimensioned >= 5. -! igds(1)=Source of grid definition (see Code Table 3.0) -! igds(2)=Number of grid points in the defined grid. -! igds(3)=Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! igds(4)=Interpretation of list for optional points -! definition. (Code Table 3.11) -! igds(5)=Grid Definition Template Number (Code Table 3.1) -! igdstmpl - Contains the data values for the specified Grid Definition -! Template ( NN=igds(5) ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Defintion Template 3.NN -! mapgridlen- Number of elements in igdstmpl(). i.e. number of entries -! in Grid Defintion Template 3.NN ( NN=igds(5) ). -! ideflist - (Used if igds(3) .ne. 0) This array contains the -! number of grid points contained in each row ( or column ). -! (part of Section 3) -! idefnum - (Used if igds(3) .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. -! ierr - Error return code. -! 0 = no error -! 5 = "GRIB" message contains an undefined Grid Definition -! Template. -! -! REMARKS: Uses Fortran 90 module gridtemplates. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use gridtemplates - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*) - integer,intent(out) :: ierr,idefnum - - integer,allocatable :: mapgrid(:) - integer :: mapgridlen,ibyttem - logical needext - - ierr=0 - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - - call gbyte(cgrib,igds(1),iofst,8) ! Get source of Grid def. - iofst=iofst+8 - call gbyte(cgrib,igds(2),iofst,32) ! Get number of grid pts. - iofst=iofst+32 - call gbyte(cgrib,igds(3),iofst,8) ! Get num octets for opt. list - iofst=iofst+8 - call gbyte(cgrib,igds(4),iofst,8) ! Get interpret. for opt. list - iofst=iofst+8 - call gbyte(cgrib,igds(5),iofst,16) ! Get Grid Def Template num. - iofst=iofst+16 - if (igds(1).eq.0) then -! if (igds(1).eq.0.OR.igds(1).eq.255) then ! FOR ECMWF TEST ONLY - allocate(mapgrid(lensec)) - ! Get Grid Definition Template - call getgridtemplate(igds(5),mapgridlen,mapgrid,needext, - & iret) - if (iret.ne.0) then - ierr=5 - return - endif - else -! igdstmpl=-1 - mapgridlen=0 - needext=.false. - endif - ! - ! Unpack each value into array igdstmpl from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapgrid. - ! - ibyttem=0 - do i=1,mapgridlen - nbits=iabs(mapgrid(i))*8 - if ( mapgrid(i).ge.0 ) then - call gbyte(cgrib,igdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) - endif - iofst=iofst+nbits - ibyttem=ibyttem+iabs(mapgrid(i)) - enddo - ! - ! Check to see if the Grid Definition Template needs to be - ! extended. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid) - ! Unpack the rest of the Grid Definition Template - do i=mapgridlen+1,newmapgridlen - nbits=iabs(mapgrid(i))*8 - if ( mapgrid(i).ge.0 ) then - call gbyte(cgrib,igdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) - endif - iofst=iofst+nbits - ibyttem=ibyttem+iabs(mapgrid(i)) - enddo - mapgridlen=newmapgridlen - endif - ! - ! Unpack optional list of numbers defining number of points - ! in each row or column, if included. This is used for non regular - ! grids. - ! - if ( igds(3).ne.0 ) then - nbits=igds(3)*8 - idefnum=(lensec-14-ibyttem)/igds(3) - call gbytes(cgrib,ideflist,iofst,nbits,0,idefnum) - iofst=iofst+(nbits*idefnum) - else - idefnum=0 - endif - if( allocated(mapgrid) ) deallocate(mapgrid) - return ! End of Section 3 processing - end - - - subroutine unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen, - & coordlist,numcoord,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: unpack4 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 4 (Product Definition Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen, -! & coordlist,numcoord,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 4. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset of the end of Section 4, returned. -! ipdsnum - Product Definition Template Number ( see Code Table 4.0) -! ipdstmpl - Contains the data values for the specified Product Definition -! Template ( N=ipdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 4.N -! mappdslen- Number of elements in ipdstmpl(). i.e. number of entries -! in Product Defintion Template 4.N ( N=ipdsnum ). -! coordlist- Array containg floating point values intended to document -! the vertical discretisation associated to model data -! on hybrid coordinate vertical levels. (part of Section 4) -! numcoord - number of values in array coordlist. -! ierr - Error return code. -! 0 = no error -! 5 = "GRIB" message contains an undefined Product Definition -! Template. -! -! REMARKS: Uses Fortran 90 module pdstemplates. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use pdstemplates - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - real,intent(out) :: coordlist(*) - integer,intent(out) :: ipdsnum,ipdstmpl(*) - integer,intent(out) :: ierr,numcoord - - real(4),allocatable :: coordieee(:) - integer,allocatable :: mappds(:) - integer :: mappdslen - logical needext - - ierr=0 - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - allocate(mappds(lensec)) - - call gbyte(cgrib,numcoord,iofst,16) ! Get num of coordinate values - iofst=iofst+16 - call gbyte(cgrib,ipdsnum,iofst,16) ! Get Prod. Def Template num. - iofst=iofst+16 - ! Get Product Definition Template - call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret) - if (iret.ne.0) then - ierr=5 - return - endif - ! - ! Unpack each value into array ipdstmpl from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mappds. - ! - do i=1,mappdslen - nbits=iabs(mappds(i))*8 - if ( mappds(i).ge.0 ) then - call gbyte(cgrib,ipdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i) - endif - iofst=iofst+nbits - enddo - ! - ! Check to see if the Product Definition Template needs to be - ! extended. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extpdstemplate(ipdsnum,ipdstmpl,newmappdslen,mappds) - ! Unpack the rest of the Product Definition Template - do i=mappdslen+1,newmappdslen - nbits=iabs(mappds(i))*8 - if ( mappds(i).ge.0 ) then - call gbyte(cgrib,ipdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i) - endif - iofst=iofst+nbits - enddo - mappdslen=newmappdslen - endif - ! - ! Get Optional list of vertical coordinate values - ! after the Product Definition Template, if necessary. - ! - if ( numcoord .ne. 0 ) then - allocate (coordieee(numcoord)) - call gbytes(cgrib,coordieee,iofst,32,0,numcoord) - call rdieee(coordieee,coordlist,numcoord) - deallocate (coordieee) - iofst=iofst+(32*numcoord) - endif - if( allocated(mappds) ) deallocate(mappds) - return ! End of Section 4 processing - end - - - subroutine unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl, - & mapdrslen,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: unpack5 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 5 (Data Representation Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl, -! mapdrslen,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 5. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 5, returned. -! ndpts - Number of data points unpacked and returned. -! idrsnum - Data Representation Template Number ( see Code Table 5.0) -! idrstmpl - Contains the data values for the specified Data Representation -! Template ( N=idrsnum ). Each element of this integer -! array contains an entry (in the order specified) of Data -! Representation Template 5.N -! mapdrslen- Number of elements in idrstmpl(). i.e. number of entries -! in Data Representation Template 5.N ( N=idrsnum ). -! ierr - Error return code. -! 0 = no error -! 7 = "GRIB" message contains an undefined Data -! Representation Template. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use drstemplates - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: ndpts,idrsnum,idrstmpl(*) - integer,intent(out) :: ierr - -C integer,allocatable :: mapdrs(:) - integer,allocatable :: mapdrs(:) - integer :: mapdrslen - logical needext - - ierr=0 - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - allocate(mapdrs(lensec)) - - call gbyte(cgrib,ndpts,iofst,32) ! Get num of data points - iofst=iofst+32 - call gbyte(cgrib,idrsnum,iofst,16) ! Get Data Rep Template Num. - iofst=iofst+16 - ! Gen Data Representation Template - call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret) - if (iret.ne.0) then - ierr=7 - return - endif - ! - ! Unpack each value into array ipdstmpl from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mappds. - ! - do i=1,mapdrslen - nbits=iabs(mapdrs(i))*8 - if ( mapdrs(i).ge.0 ) then - call gbyte(cgrib,idrstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) idrstmpl(i)=-idrstmpl(i) - endif - iofst=iofst+nbits - enddo - ! - ! Check to see if the Data Representation Template needs to be - ! extended. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extdrstemplate(idrsnum,idrstmpl,newmapdrslen,mapdrs) - ! Unpack the rest of the Data Representation Template - do i=mapdrslen+1,newmapdrslen - nbits=iabs(mapdrs(i))*8 - if ( mapdrs(i).ge.0 ) then - call gbyte(cgrib,idrstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) idrstmpl(i)=-idrstmpl(i) - endif - iofst=iofst+nbits - enddo - mapdrslen=newmapdrslen - endif - if( allocated(mapdrs) ) deallocate(mapdrs) - return ! End of Section 5 processing - end - - - subroutine unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: unpack6 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 6 (Bit-Map Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 6. -! ngpts - Number of grid points specified in the bit-map -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 6, returned. -! ibmap - Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! bmap() - Logical*1 array containing decoded bitmap. ( if ibmap=0 ) -! ierr - Error return code. -! 0 = no error -! 4 = Unrecognized pre-defined bit-map. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ngpts - integer,intent(inout) :: iofst - integer,intent(out) :: ibmap - integer,intent(out) :: ierr - logical*1,intent(out) :: bmap(ngpts) - - integer :: intbmap(ngpts) - - ierr=0 - - iofst=iofst+32 ! skip Length of Section - iofst=iofst+8 ! skip section number - - call gbyte(cgrib,ibmap,iofst,8) ! Get bit-map indicator - iofst=iofst+8 - - if (ibmap.eq.0) then ! Unpack bitmap - call gbytes(cgrib,intbmap,iofst,1,0,ngpts) - iofst=iofst+ngpts - do j=1,ngpts - bmap(j)=.true. - if (intbmap(j).eq.0) bmap(j)=.false. - enddo - elseif (ibmap.eq.254) then ! Use previous bitmap - return - elseif (ibmap.eq.255) then ! No bitmap in message - bmap(1:ngpts)=.true. - else - print *,'unpack6: Predefined bitmap ',ibmap,' not recognized.' - ierr=4 - endif - - return ! End of Section 6 processing - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getg2i.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getg2i.f deleted file mode 100755 index ffaa9b3195..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getg2i.f +++ /dev/null @@ -1,93 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETG2I READS A GRIB2 INDEX FILE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: READ A GRIB2 INDEX FILE AND RETURN ITS CONTENTS. -C VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT: -C 81-BYTE S.LORD HEADER WITH 'GB2IX1' IN COLUMNS 42-47 FOLLOWED BY -C 81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS, -C TOTAL LENGTH IN BYTES OF THE INDEX RECORDS, NUMBER OF INDEX RECORDS, -C AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40). -C EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE -C AND HAS THE INTERNAL FORMAT: -C BYTE 001 - 004: LENGTH OF INDEX RECORD -C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE) -C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE. -C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS -C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS -C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS -C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION -C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE -C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 ) -C BYTE 042 - 042: MESSAGE DISCIPLINE -C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE -C BYTE 045 - II: IDENTIFICATION SECTION (IDS) -C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS) -C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS) -C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS) -C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS) -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 -C 2002-01-03 GILBERT MODIFIED FROM GETGI TO WORK WITH GRIB2 -C -C USAGE: CALL GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) -C INPUT ARGUMENTS: -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS. -C USERS SHOULD FREE MEMORY THAT CBUF POINTS TO -C USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED. -C NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS -C NNUM INTEGER NUMBER OF INDEX RECORDS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 2 NOT ENOUGH MEMORY TO HOLD INDEX BUFFER -C 3 ERROR READING INDEX FILE BUFFER -C 4 ERROR READING INDEX FILE HEADER -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGI - INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET - CHARACTER CHEAD*162 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF (ASSOCIATED(CBUF)) NULLIFY(CBUF) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - NLEN=0 - NNUM=0 - IRET=4 - CALL BAREAD(LUGI,0,162,LHEAD,CHEAD) - IF(LHEAD.EQ.162.AND.CHEAD(42:47).EQ.'GB2IX1') THEN - READ(CHEAD(82:162),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM - IF(IOS.EQ.0) THEN - - ALLOCATE(CBUF(NLEN),STAT=ISTAT) ! ALLOCATE SPACE FOR CBUF - IF (ISTAT.NE.0) THEN - IRET=2 - RETURN - ENDIF - IRET=0 - CALL BAREAD(LUGI,NSKP,NLEN,LBUF,CBUF) - IF(LBUF.NE.NLEN) IRET=3 - - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getg2ir.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getg2ir.f deleted file mode 100755 index d58ba036c2..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getg2ir.f +++ /dev/null @@ -1,138 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETG2IR CREATES AN INDEX OF A GRIB2 FILE -C PRGMMR: GILBERT ORG: W/NP11 DATE: 2002-01-02 -C -C ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS. -C THE INDEX BUFFER RETURNED CONTAINS INDEX RECORDS WITH THE INTERNAL FORMAT: -C BYTE 001 - 004: LENGTH OF INDEX RECORD -C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE) -C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE. -C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS -C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS -C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS -C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION -C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE -C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 ) -C BYTE 042 - 042: MESSAGE DISCIPLINE -C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE -C BYTE 045 - II: IDENTIFICATION SECTION (IDS) -C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS) -C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS) -C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS) -C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS) -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 -C 2002-01-02 GILBERT MODIFIED FROM GETGIR TO CREATE GRIB2 INDEXES -C -C USAGE: CALL GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB FILE -C MSK1 INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE -C MSK2 INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES -C MNUM INTEGER NUMBER OF GRIB MESSAGES TO SKIP (USUALLY 0) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS. -C USERS SHOULD FREE MEMORY THAT CBUF POINTS TO -C USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED. -C NLEN INTEGER TOTAL LENGTH OF INDEX RECORD BUFFER IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (=0 IF NO GRIB MESSAGES ARE FOUND) -C NMESS LAST GRIB MESSAGE IN FILE SUCCESSFULLY PROCESSED -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 1 NOT ENOUGH MEMORY AVAILABLE TO HOLD FULL INDEX -C BUFFER -C 2 NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER -C -C SUBPROGRAMS CALLED: -C SKGB SEEK NEXT GRIB MESSAGE -C IXGB2 MAKE INDEX RECORD -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE RE_ALLOC ! NEEDED FOR SUBROUTINE REALLOC - PARAMETER(INIT=50000,NEXT=10000) - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM - INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUFTMP - INTERFACE ! REQUIRED FOR CBUF POINTER - SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET) - INTEGER,INTENT(IN) :: LUGB,LSKIP,LGRIB - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(OUT) :: NUMFLD,MLEN,IRET - END SUBROUTINE IXGB2 - END INTERFACE -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C INITIALIZE - IRET=0 - IF (ASSOCIATED(CBUF)) NULLIFY(CBUF) - MBUF=INIT - ALLOCATE(CBUF(MBUF),STAT=ISTAT) ! ALLOCATE INITIAL SPACE FOR CBUF - IF (ISTAT.NE.0) THEN - IRET=2 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH FOR FIRST GRIB MESSAGE - ISEEK=0 - CALL SKGB(LUGB,ISEEK,MSK1,LSKIP,LGRIB) - DO M=1,MNUM - IF(LGRIB.GT.0) THEN - ISEEK=LSKIP+LGRIB - CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB) - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET INDEX RECORDS FOR EVERY GRIB MESSAGE FOUND - NLEN=0 - NNUM=0 - NMESS=MNUM - DOWHILE(IRET.EQ.0.AND.LGRIB.GT.0) - CALL IXGB2(LUGB,LSKIP,LGRIB,CBUFTMP,NUMFLD,NBYTES,IRET1) - IF (IRET1.NE.0) PRINT *,' SAGT ',NUMFLD,NBYTES,IRET1 - IF((NBYTES+NLEN).GT.MBUF) THEN ! ALLOCATE MORE SPACE, IF - ! NECESSARY - NEWSIZE=MAX(MBUF+NEXT,MBUF+NBYTES) - CALL REALLOC(CBUF,NLEN,NEWSIZE,ISTAT) - IF ( ISTAT .NE. 0 ) THEN - IRET=1 - RETURN - ENDIF - MBUF=NEWSIZE - ENDIF - ! - ! IF INDEX RECORDS WERE RETURNED IN CBUFTMP FROM IXGB2, - ! COPY CBUFTMP INTO CBUF, THEN DEALLOCATE CBUFTMP WHEN DONE - ! - IF ( ASSOCIATED(CBUFTMP) ) THEN - CBUF(NLEN+1:NLEN+NBYTES)=CBUFTMP(1:NBYTES) - DEALLOCATE(CBUFTMP,STAT=ISTAT) - IF (ISTAT.NE.0) THEN - PRINT *,' deallocating cbuftmp ... ',istat - stop 99 - ENDIF - NULLIFY(CBUFTMP) - NNUM=NNUM+NUMFLD - NLEN=NLEN+NBYTES - NMESS=NMESS+1 - ENDIF - ! LOOK FOR NEXT GRIB MESSAGE - ISEEK=LSKIP+LGRIB - CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB) - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2.f deleted file mode 100755 index 9acf23a10b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2.f +++ /dev/null @@ -1,331 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, - & UNPACK,K,GFLD,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2 FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED. -C THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP -C AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND -C PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER -C OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS NUMBER IS RETURNED ALONG WITH -C THE ASSOCIATED UNPACKED PARAMETERS. THE BITMAP (IF ANY), -C AND THE DATA VALUES ARE UNPACKED ONLY IF ARGUMENT "UNPACK" IS SET TO -C TRUE. IF THE GRIB FIELD IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C The decoded information for the selected GRIB field -C is returned in a derived type variable, gfld. -C Gfld is of type gribfield, which is defined -C in module grib_mod, so users of this routine will need to include -C the line "USE GRIB_MOD" in their calling routine. Each component of the -C gribfield type is described in the OUTPUT ARGUMENT LIST section below. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C 2002-01-11 GILBERT MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2 -C -C USAGE: CALL GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, -C & UNPACK,K,GFLD,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE. -C FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING -C THIS ROUTINE. -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE. -C IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE -C CALLING THIS ROUTINE. -C >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T -C ALREADY EXIST. -C =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX -C DOESN"T ALREADY EXIST. -C <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI). -C =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB. -C J INTEGER NUMBER OF FIELDS TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD -C ( IF = -1, ACCEPT ANY DISCIPLINE) -C ( SEE CODE TABLE 0.0 ) -C 0 - Meteorological products -C 1 - Hydrological products -C 2 - Land surface products -C 3 - Space products -C 10 - Oceanographic products -C JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION -C (=-9999 FOR WILDCARD) -C JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE -C ( SEE COMMON CODE TABLE C-1 ) -C JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE -C JIDS(3) = GRIB MASTER TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C JIDS(6) = YEAR ( 4 DIGITS ) -C JIDS(7) = MONTH -C JIDS(8) = DAY -C JIDS(9) = HOUR -C JIDS(10) = MINUTE -C JIDS(11) = SECOND -C JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA -C ( SEE CODE TABLE 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N) -C ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY ) -C JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION -C TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M) -C ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY ) -C JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION -C TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C UNPACK LOGICAL VALUE INDICATING WHETHER TO UNPACK BITMAP/DATA -C .TRUE. = UNPACK BITMAP AND DATA VALUES -C .FALSE. = DO NOT UNPACK BITMAP AND DATA VALUES -C -C OUTPUT ARGUMENTS: -C K INTEGER FIELD NUMBER UNPACKED -C gfld - derived type gribfield ( defined in module grib_mod ) -C ( NOTE: See Remarks Section ) -C gfld%version = GRIB edition number ( currently 2 ) -C gfld%discipline = Message Discipline ( see Code Table 0.0 ) -C gfld%idsect() = Contains the entries in the Identification -C Section ( Section 1 ) -C This element is actually a pointer to an array -C that holds the data. -C gfld%idsect(1) = Identification of originating Centre -C ( see Common Code Table C-1 ) -C 7 - US National Weather Service -C gfld%idsect(2) = Identification of originating Sub-centre -C gfld%idsect(3) = GRIB Master Tables Version Number -C ( see Code Table 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C gfld%idsect(4) = GRIB Local Tables Version Number -C ( see Code Table 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C gfld%idsect(6) = Year ( 4 digits ) -C gfld%idsect(7) = Month -C gfld%idsect(8) = Day -C gfld%idsect(9) = Hour -C gfld%idsect(10) = Minute -C gfld%idsect(11) = Second -C gfld%idsect(12) = Production status of processed data -C ( see Code Table 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C gfld%idsectlen = Number of elements in gfld%idsect(). -C gfld%local() = Pointer to character array containing contents -C of Local Section 2, if included -C gfld%locallen = length of array gfld%local() -C gfld%ifldnum = field number within GRIB message -C gfld%griddef = Source of grid definition (see Code Table 3.0) -C 0 - Specified in Code table 3.1 -C 1 - Predetermined grid Defined by originating centre -C gfld%ngrdpts = Number of grid points in the defined grid. -C gfld%numoct_opt = Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C gfld%interp_opt = Interpretation of list for optional points -C definition. (Code Table 3.11) -C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -C gfld%igdtmpl() = Contains the data values for the specified Grid -C Definition Template ( NN=gfld%igdtnum ). Each -C element of this integer array contains an entry (in -C the order specified) of Grid Defintion Template 3.NN -C This element is actually a pointer to an array -C that holds the data. -C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -C entries in Grid Defintion Template 3.NN -C ( NN=gfld%igdtnum ). -C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -C contains the number of grid points contained in -C each row ( or column ). (part of Section 3) -C This element is actually a pointer to an array -C that holds the data. This pointer is nullified -C if gfld%numoct_opt=0. -C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -C in array ideflist. i.e. number of rows ( or columns ) -C for which optional grid points are defined. This value -C is set to zero, if gfld%numoct_opt=0. -C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -C gfld%ipdtmpl() = Contains the data values for the specified Product -C Definition Template ( N=gfdl%ipdtnum ). Each element -C of this integer array contains an entry (in the -C order specified) of Product Defintion Template 4.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -C entries in Product Defintion Template 4.N -C ( N=gfdl%ipdtnum ). -C gfld%coord_list() = Real array containing floating point values -C intended to document the vertical discretisation -C associated to model data on hybrid coordinate -C vertical levels. (part of Section 4) -C This element is actually a pointer to an array -C that holds the data. -C gfld%num_coord = number of values in array gfld%coord_list(). -C gfld%ndpts = Number of data points unpacked and returned. -C gfld%idrtnum = Data Representation Template Number -C ( see Code Table 5.0) -C gfld%idrtmpl() = Contains the data values for the specified Data -C Representation Template ( N=gfld%idrtnum ). Each -C element of this integer array contains an entry -C (in the order specified) of Product Defintion -C Template 5.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -C of entries in Data Representation Template 5.N -C ( N=gfld%idrtnum ). -C gfld%unpacked = logical value indicating whether the bitmap and -C data values were unpacked. If false, -C gfld%bmap and gfld%fld pointers are nullified. -C gfld%expanded = Logical value indicating whether the data field -C was expanded to the grid in the case where a -C bit-map is present. If true, the data points in -C gfld%fld match the grid points and zeros were -C inserted at grid points where data was bit-mapped -C out. If false, the data values in gfld%fld were -C not expanded to the grid and are just a consecutive -C array of data points corresponding to each value of -C "1" in gfld%bmap. -C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -C 0 = bitmap applies and is included in Section 6. -C 1-253 = Predefined bitmap applies -C 254 = Previously defined bitmap applies to this field -C 255 = Bit map does not apply to this product. -C gfld%bmap() = Logical*1 array containing decoded bitmap, -C if ibmap=0 or ibap=254. Otherwise nullified. -C This element is actually a pointer to an array -C that holds the data. -C gfld%fld() = Array of gfld%ndpts unpacked data points. -C This element is actually a pointer to an array -C that holds the data. -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX -C 97 ERROR READING GRIB FILE -C 99 REQUEST NOT FOUND -C OTHER GF_GETFLD GRIB2 UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETIDX GET INDEX -C GETGB2S SEARCH INDEX RECORDS -C GETGB2R READ AND UNPACK GRIB RECORD -C GF_FREE FREES MEMORY USED BY GFLD ( SEE REMARKS ) -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE GRIB_MOD - - INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN - INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*) - LOGICAL,INTENT(IN) :: UNPACK - INTEGER,INTENT(OUT) :: K,IRET - TYPE(GRIBFIELD),INTENT(OUT) :: GFLD - - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DECLARE INTERFACES (REQUIRED FOR CBUF POINTER) - INTERFACE - SUBROUTINE GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI) - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGB,LUGI - INTEGER,INTENT(OUT) :: NLEN,NNUM,IRGI - END SUBROUTINE GETIDX - END INTERFACE -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IRGI=0 - CALL GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI) - IF(IRGI.GT.1) THEN - IRET=96 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH INDEX BUFFER - CALL GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, - & JK,GFLD,LPOS,IRGS) - IF(IRGS.NE.0) THEN - IRET=99 - CALL GF_FREE(GFLD) - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ LOCAL USE SECTION, IF AVAILABLE - CALL GETGB2L(LUGB,CBUF(LPOS),GFLD,IRET) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK GRIB RECORD - IF (UNPACK) THEN - ! NUMFLD=GFLD%IFLDNUM - ! CALL GF_FREE(GFLD) - CALL GETGB2R(LUGB,CBUF(LPOS),GFLD,IRET) - ENDIF - K=JK -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2l.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2l.f deleted file mode 100755 index 0705ccfb1f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2l.f +++ /dev/null @@ -1,234 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB2L(LUGB,CINDEX,GFLD,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2L EXTRACTS LOCAL USE SECTION -C PRGMMR: GILBERT ORG: W/NP11 DATE: 02-05-07 -C -C ABSTRACT: READ AND UNPACK A LOCAL USE SECTION FROM A GRIB2 MESSAGE. -C -C The decoded information for the selected GRIB field -C is returned in a derived type variable, gfld. -C Gfld is of type gribfield, which is defined -C in module grib_mod, so users of this routine will need to include -C the line "USE GRIB_MOD" in their calling routine. Each component of the -C gribfield type is described in the OUTPUT ARGUMENT LIST section below. -C -C PROGRAM HISTORY LOG: -C 2002-05-07 GILBERT -C -C USAGE: CALL GETGB2L(LUGB,CINDEX,GFLD,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C CINDEX INDEX RECORD OF THE GRIB FIELD ( SEE DOCBLOCK OF -C SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.) -C OUTPUT ARGUMENTS: -C gfld - derived type gribfield ( defined in module grib_mod ) -C ( NOTE: See Remarks Section ) -C gfld%version = GRIB edition number ( currently 2 ) -C gfld%discipline = Message Discipline ( see Code Table 0.0 ) -C gfld%idsect() = Contains the entries in the Identification -C Section ( Section 1 ) -C This element is actually a pointer to an array -C that holds the data. -C gfld%idsect(1) = Identification of originating Centre -C ( see Common Code Table C-1 ) -C 7 - US National Weather Service -C gfld%idsect(2) = Identification of originating Sub-centre -C gfld%idsect(3) = GRIB Master Tables Version Number -C ( see Code Table 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C gfld%idsect(4) = GRIB Local Tables Version Number -C ( see Code Table 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C gfld%idsect(6) = Year ( 4 digits ) -C gfld%idsect(7) = Month -C gfld%idsect(8) = Day -C gfld%idsect(9) = Hour -C gfld%idsect(10) = Minute -C gfld%idsect(11) = Second -C gfld%idsect(12) = Production status of processed data -C ( see Code Table 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C gfld%idsectlen = Number of elements in gfld%idsect(). -C gfld%local() = Pointer to character array containing contents -C of Local Section 2, if included -C gfld%locallen = length of array gfld%local() -C gfld%ifldnum = field number within GRIB message -C gfld%griddef = Source of grid definition (see Code Table 3.0) -C 0 - Specified in Code table 3.1 -C 1 - Predetermined grid Defined by originating centre -C gfld%ngrdpts = Number of grid points in the defined grid. -C gfld%numoct_opt = Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C gfld%interp_opt = Interpretation of list for optional points -C definition. (Code Table 3.11) -C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -C gfld%igdtmpl() = Contains the data values for the specified Grid -C Definition Template ( NN=gfld%igdtnum ). Each -C element of this integer array contains an entry (in -C the order specified) of Grid Defintion Template 3.NN -C This element is actually a pointer to an array -C that holds the data. -C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -C entries in Grid Defintion Template 3.NN -C ( NN=gfld%igdtnum ). -C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -C contains the number of grid points contained in -C each row ( or column ). (part of Section 3) -C This element is actually a pointer to an array -C that holds the data. This pointer is nullified -C if gfld%numoct_opt=0. -C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -C in array ideflist. i.e. number of rows ( or columns ) -C for which optional grid points are defined. This value -C is set to zero, if gfld%numoct_opt=0. -C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -C gfld%ipdtmpl() = Contains the data values for the specified Product -C Definition Template ( N=gfdl%ipdtnum ). Each element -C of this integer array contains an entry (in the -C order specified) of Product Defintion Template 4.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -C entries in Product Defintion Template 4.N -C ( N=gfdl%ipdtnum ). -C gfld%coord_list() = Real array containing floating point values -C intended to document the vertical discretisation -C associated to model data on hybrid coordinate -C vertical levels. (part of Section 4) -C This element is actually a pointer to an array -C that holds the data. -C gfld%num_coord = number of values in array gfld%coord_list(). -C gfld%ndpts = Number of data points unpacked and returned. -C gfld%idrtnum = Data Representation Template Number -C ( see Code Table 5.0) -C gfld%idrtmpl() = Contains the data values for the specified Data -C Representation Template ( N=gfld%idrtnum ). Each -C element of this integer array contains an entry -C (in the order specified) of Product Defintion -C Template 5.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -C of entries in Data Representation Template 5.N -C ( N=gfld%idrtnum ). -C gfld%unpacked = logical value indicating whether the bitmap and -C data values were unpacked. If false, -C gfld%bmap and gfld%fld pointers are nullified. -C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -C 0 = bitmap applies and is included in Section 6. -C 1-253 = Predefined bitmap applies -C 254 = Previously defined bitmap applies to this field -C 255 = Bit map does not apply to this product. -C gfld%bmap() = Logical*1 array containing decoded bitmap, -C if ibmap=0 or ibap=254. Otherwise nullified. -C This element is actually a pointer to an array -C that holds the data. -C gfld%fld() = Array of gfld%ndpts unpacked data points. -C This element is actually a pointer to an array -C that holds the data. -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 97 ERROR READING GRIB FILE -C OTHER GF_GETFLD GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C GF_GETFLD UNPACK GRIB FIELD -C -C REMARKS: -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY. -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE GRIB_MOD - - INTEGER,INTENT(IN) :: LUGB - CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*) - INTEGER,INTENT(OUT) :: IRET - TYPE(GRIBFIELD) :: GFLD - - INTEGER :: LSKIP,SKIP2 - CHARACTER(LEN=1):: CSIZE(4) - CHARACTER(LEN=1),ALLOCATABLE :: CTEMP(:) - - interface - subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: lencsec2 - integer,intent(out) :: ierr - character(len=1),pointer,dimension(:) :: csec2 - end subroutine gf_unpack2 - end interface -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET INFO - NULLIFY(gfld%local) - IRET=0 - CALL GBYTE(CINDEX,LSKIP,4*8,4*8) - CALL GBYTE(CINDEX,SKIP2,8*8,4*8) - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK LOCAL USE SECTION, IF PRESENT - IF ( SKIP2.NE.0 ) THEN - ISKIP=LSKIP+SKIP2 - CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE) ! GET LENGTH OF SECTION - CALL GBYTE(CSIZE,ILEN,0,32) - ALLOCATE(CTEMP(ILEN)) - CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP) ! READ IN SECTION - IF (ILEN.NE.LREAD) THEN - IRET=97 - DEALLOCATE(CTEMP) - RETURN - ENDIF - IOFST=0 - CALL GF_UNPACK2(CTEMP,ILEN,IOFST,gfld%locallen, - & gfld%local,ierr) - IF (IERR.NE.0) THEN - IRET=98 - DEALLOCATE(CTEMP) - RETURN - ENDIF - DEALLOCATE(CTEMP) - ELSE - gfld%locallen=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2p.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2p.f deleted file mode 100755 index 19d5b800a0..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2p.f +++ /dev/null @@ -1,223 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB2P(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, - & EXTRACT,K,GRIBM,LENG,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2P FINDS AND EXTRACTS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND EXTRACTS A GRIB MESSAGE FROM A FILE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED. -C THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP -C AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND -C PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER -C OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND RETURNED. -C IF THE GRIB FIELD IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C 2002-01-11 GILBERT MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2 -C 2003-12-17 GILBERT MODIFIED FROM GETGB2 TO RETURN PACKED GRIB2 MESSAGE. -C -C USAGE: CALL GETGB2P(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, -C & EXTRACT,K,GRIBM,LENG,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE. -C FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING -C THIS ROUTINE. -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE. -C IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE -C CALLING THIS ROUTINE. -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C J INTEGER NUMBER OF FIELDS TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD -C ( IF = -1, ACCEPT ANY DISCIPLINE) -C ( SEE CODE TABLE 0.0 ) -C 0 - Meteorological products -C 1 - Hydrological products -C 2 - Land surface products -C 3 - Space products -C 10 - Oceanographic products -C JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION -C (=-9999 FOR WILDCARD) -C JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE -C ( SEE COMMON CODE TABLE C-1 ) -C JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE -C JIDS(3) = GRIB MASTER TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C JIDS(6) = YEAR ( 4 DIGITS ) -C JIDS(7) = MONTH -C JIDS(8) = DAY -C JIDS(9) = HOUR -C JIDS(10) = MINUTE -C JIDS(11) = SECOND -C JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA -C ( SEE CODE TABLE 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N) -C ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY ) -C JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION -C TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M) -C ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY ) -C JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION -C TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C EXTRACT LOGICAL VALUE INDICATING WHETHER TO RETURN A GRIB2 -C MESSAGE WITH JUST THE REQUESTED FIELD, OR THE ENTIRE -C GRIB2 MESSAGE CONTAINING THE REQUESTED FIELD. -C .TRUE. = RETURN GRIB2 MESSAGE CONTAINING ONLY THE REQUESTED -C FIELD. -C .FALSE. = RETURN ENTIRE GRIB2 MESSAGE CONTAINING THE -C REQUESTED FIELD. -C -C OUTPUT ARGUMENTS: -C K INTEGER FIELD NUMBER RETURNED. -C GRIBM RETURNED GRIB MESSAGE. -C LENG LENGTH OF RETURNED GRIB MESSAGE IN BYTES. -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETG2I READ INDEX FILE -C GETG2IR READ INDEX BUFFER FROM GRIB FILE -C GETGB2S SEARCH INDEX RECORDS -C GETGB2RP READ A PACKED GRIB RECORD -C GF_FREE FREES MEMORY USED BY GFLD ( SEE REMARKS ) -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE GRIB_MOD - - INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN - INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*) - LOGICAL,INTENT(IN) :: EXTRACT - INTEGER,INTENT(OUT) :: K,IRET,LENG - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM - - TYPE(GRIBFIELD) :: GFLD - - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - PARAMETER(MSK1=32000,MSK2=4000) - - SAVE CBUF,NLEN,NNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DECLARE INTERFACES (REQUIRED FOR CBUF POINTER) - INTERFACE - SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGI - INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET - END SUBROUTINE GETG2I - SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM, - & NMESS,IRET) - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM - INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET - END SUBROUTINE GETG2IR - SUBROUTINE GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET) - INTEGER,INTENT(IN) :: LUGB - CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*) - LOGICAL,INTENT(IN) :: EXTRACT - INTEGER,INTENT(OUT) :: LENG,IRET - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM - END SUBROUTINE GETGB2RP - END INTERFACE - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IRGI=0 - IF(LUGI.GT.0.AND.LUGI.NE.LUX) THEN - CALL GETG2I(LUGI,CBUF,NLEN,NNUM,IRGI) - LUX=LUGI - ELSEIF(LUGI.LE.0.AND.LUGB.NE.LUX) THEN - MSKP=0 - CALL GETG2IR(LUGB,MSK1,MSK2,MSKP,CBUF,NLEN,NNUM,NMESS,IRGI) - LUX=LUGB - ENDIF - IF(IRGI.GT.1) THEN - IRET=96 - LUX=0 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH INDEX BUFFER - CALL GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, - & JK,GFLD,LPOS,IRGS) - IF(IRGS.NE.0) THEN - IRET=99 - CALL GF_FREE(GFLD) - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C EXTRACT GRIB MESSAGE FROM FILE - CALL GETGB2RP(LUGB,CBUF(LPOS:),EXTRACT,GRIBM,LENG,IRET) -! IF ( EXTRACT ) THEN -! PRINT *,'NOT SUPPOSED TO BE HERE.' -! ELSE -! IPOS=(LPOS+3)*8 -! CALL GBYTE(CBUF,ISKIP,IPOS,32) ! BYTES TO SKIP IN FILE -! IPOS=IPOS+(32*8) -! CALL GBYTE(CBUF,LENG,IPOS,32) ! LENGTH OF GRIB MESSAGE -! IF (.NOT. ASSOCIATED(GRIBM)) ALLOCATE(GRIBM(LENG)) -! CALL BAREAD(LUGB,ISKIP,LENG,LREAD,GRIBM) -! IF ( LENG .NE. LREAD ) THEN -! IRET=97 -! CALL GF_FREE(GFLD) -! RETURN -! ENDIF -! ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - K=JK - CALL GF_FREE(GFLD) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2r.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2r.f deleted file mode 100755 index 50c28a5022..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2r.f +++ /dev/null @@ -1,304 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB2R(LUGB,CINDEX,GFLD,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2R READS AND UNPACKS A GRIB FIELD -C PRGMMR: GILBERT ORG: W/NP11 DATE: 02-01-15 -C -C ABSTRACT: READ AND UNPACK SECTIONS 6 AND 7 FROM A GRIB2 MESSAGE. -C -C This routine assumes that the "metadata" for this field -C already exists in derived type gribfield. Specifically, -C it requires gfld%ibmap,gfld%ngrdpts,gfld%idrtnum,gfld%idrtmpl, -C and gfld%ndpts. -C -C The decoded information for the selected GRIB field -C is returned in a derived type variable, gfld. -C Gfld is of type gribfield, which is defined -C in module grib_mod, so users of this routine will need to include -C the line "USE GRIB_MOD" in their calling routine. Each component of the -C gribfield type is described in the OUTPUT ARGUMENT LIST section below. -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 2002-01-11 GILBERT MODIFIED FROM GETGB1R TO WORK WITH GRIB2 -C -C USAGE: CALL GETGB2R(LUGB,CINDEX,GFLD,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C CINDEX INDEX RECORD OF THE GRIB FIELD ( SEE DOCBLOCK OF -C SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.) -C OUTPUT ARGUMENTS: -C gfld - derived type gribfield ( defined in module grib_mod ) -C ( NOTE: See Remarks Section ) -C gfld%version = GRIB edition number ( currently 2 ) -C gfld%discipline = Message Discipline ( see Code Table 0.0 ) -C gfld%idsect() = Contains the entries in the Identification -C Section ( Section 1 ) -C This element is actually a pointer to an array -C that holds the data. -C gfld%idsect(1) = Identification of originating Centre -C ( see Common Code Table C-1 ) -C 7 - US National Weather Service -C gfld%idsect(2) = Identification of originating Sub-centre -C gfld%idsect(3) = GRIB Master Tables Version Number -C ( see Code Table 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C gfld%idsect(4) = GRIB Local Tables Version Number -C ( see Code Table 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C gfld%idsect(6) = Year ( 4 digits ) -C gfld%idsect(7) = Month -C gfld%idsect(8) = Day -C gfld%idsect(9) = Hour -C gfld%idsect(10) = Minute -C gfld%idsect(11) = Second -C gfld%idsect(12) = Production status of processed data -C ( see Code Table 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C gfld%idsectlen = Number of elements in gfld%idsect(). -C gfld%local() = Pointer to character array containing contents -C of Local Section 2, if included -C gfld%locallen = length of array gfld%local() -C gfld%ifldnum = field number within GRIB message -C gfld%griddef = Source of grid definition (see Code Table 3.0) -C 0 - Specified in Code table 3.1 -C 1 - Predetermined grid Defined by originating centre -C gfld%ngrdpts = Number of grid points in the defined grid. -C gfld%numoct_opt = Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C gfld%interp_opt = Interpretation of list for optional points -C definition. (Code Table 3.11) -C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -C gfld%igdtmpl() = Contains the data values for the specified Grid -C Definition Template ( NN=gfld%igdtnum ). Each -C element of this integer array contains an entry (in -C the order specified) of Grid Defintion Template 3.NN -C This element is actually a pointer to an array -C that holds the data. -C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -C entries in Grid Defintion Template 3.NN -C ( NN=gfld%igdtnum ). -C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -C contains the number of grid points contained in -C each row ( or column ). (part of Section 3) -C This element is actually a pointer to an array -C that holds the data. This pointer is nullified -C if gfld%numoct_opt=0. -C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -C in array ideflist. i.e. number of rows ( or columns ) -C for which optional grid points are defined. This value -C is set to zero, if gfld%numoct_opt=0. -C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -C gfld%ipdtmpl() = Contains the data values for the specified Product -C Definition Template ( N=gfdl%ipdtnum ). Each element -C of this integer array contains an entry (in the -C order specified) of Product Defintion Template 4.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -C entries in Product Defintion Template 4.N -C ( N=gfdl%ipdtnum ). -C gfld%coord_list() = Real array containing floating point values -C intended to document the vertical discretisation -C associated to model data on hybrid coordinate -C vertical levels. (part of Section 4) -C This element is actually a pointer to an array -C that holds the data. -C gfld%num_coord = number of values in array gfld%coord_list(). -C gfld%ndpts = Number of data points unpacked and returned. -C gfld%idrtnum = Data Representation Template Number -C ( see Code Table 5.0) -C gfld%idrtmpl() = Contains the data values for the specified Data -C Representation Template ( N=gfld%idrtnum ). Each -C element of this integer array contains an entry -C (in the order specified) of Product Defintion -C Template 5.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -C of entries in Data Representation Template 5.N -C ( N=gfld%idrtnum ). -C gfld%unpacked = logical value indicating whether the bitmap and -C data values were unpacked. If false, -C gfld%bmap and gfld%fld pointers are nullified. -C gfld%expanded = Logical value indicating whether the data field -C was expanded to the grid in the case where a -C bit-map is present. If true, the data points in -C gfld%fld match the grid points and zeros were -C inserted at grid points where data was bit-mapped -C out. If false, the data values in gfld%fld were -C not expanded to the grid and are just a consecutive -C array of data points corresponding to each value of -C "1" in gfld%bmap. -C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -C 0 = bitmap applies and is included in Section 6. -C 1-253 = Predefined bitmap applies -C 254 = Previously defined bitmap applies to this field -C 255 = Bit map does not apply to this product. -C gfld%bmap() = Logical*1 array containing decoded bitmap, -C if ibmap=0 or ibap=254. Otherwise nullified. -C This element is actually a pointer to an array -C that holds the data. -C gfld%fld() = Array of gfld%ndpts unpacked data points. -C This element is actually a pointer to an array -C that holds the data. -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 97 ERROR READING GRIB FILE -C OTHER GF_GETFLD GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C GF_UNPACK6 UNAPCKS BIT_MAP SECTION -C GF_UNPACK7 UNAPCKS DATA SECTION -C -C REMARKS: -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY. -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this, users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE GRIB_MOD - - INTEGER,INTENT(IN) :: LUGB - CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*) - INTEGER,INTENT(OUT) :: IRET - TYPE(GRIBFIELD) :: GFLD - - INTEGER :: LSKIP,SKIP6,SKIP7 - CHARACTER(LEN=1):: CSIZE(4) - CHARACTER(LEN=1),ALLOCATABLE :: CTEMP(:) - real,pointer,dimension(:) :: newfld - - interface - subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap, - & bmap,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ngpts - integer,intent(inout) :: iofst - integer,intent(out) :: ibmap - integer,intent(out) :: ierr - logical*1,pointer,dimension(:) :: bmap - end subroutine gf_unpack6 - subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl, - & idrsnum,idrstmpl,ndpts,fld,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ndpts,idrsnum,igdsnum - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: idrstmpl,igdstmpl - integer,intent(out) :: ierr - real,pointer,dimension(:) :: fld - end subroutine gf_unpack7 - end interface -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET INFO - NULLIFY(gfld%bmap,gfld%fld) - IRET=0 - CALL GBYTE(CINDEX,LSKIP,4*8,4*8) - CALL GBYTE(CINDEX,SKIP6,24*8,4*8) - CALL GBYTE(CINDEX,SKIP7,28*8,4*8) - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK BIT_MAP, IF PRESENT - IF ( gfld%ibmap.eq.0.OR.gfld%ibmap.eq.254 ) THEN - ISKIP=LSKIP+SKIP6 - CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE) ! GET LENGTH OF SECTION - CALL GBYTE(CSIZE,ILEN,0,32) - ALLOCATE(CTEMP(ILEN)) - CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP) ! READ IN SECTION - IF (ILEN.NE.LREAD) THEN - IRET=97 - DEALLOCATE(CTEMP) - RETURN - ENDIF - IOFST=0 - CALL GF_UNPACK6(CTEMP,ILEN,IOFST,gfld%ngrdpts,idum, - & gfld%bmap,ierr) - IF (IERR.NE.0) THEN - IRET=98 - DEALLOCATE(CTEMP) - RETURN - ENDIF - DEALLOCATE(CTEMP) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK DATA FIELD - ISKIP=LSKIP+SKIP7 - CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE) ! GET LENGTH OF SECTION - CALL GBYTE(CSIZE,ILEN,0,32) - ALLOCATE(CTEMP(ILEN)) - CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP) ! READ IN SECTION - IF (ILEN.NE.LREAD) THEN - IRET=97 - DEALLOCATE(CTEMP) - RETURN - ENDIF - IOFST=0 - CALL GF_UNPACK7(CTEMP,ILEN,IOFST,gfld%igdtnum,gfld%igdtmpl, - & gfld%idrtnum,gfld%idrtmpl,gfld%ndpts, - & gfld%fld,ierr) - IF (IERR.NE.0) THEN - IRET=98 - DEALLOCATE(CTEMP) - RETURN - ENDIF - DEALLOCATE(CTEMP) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! If bitmap is used with this field, expand data field - ! to grid, if possible. - if ( gfld%ibmap .ne. 255 .AND. associated(gfld%bmap) ) then - allocate(newfld(gfld%ngrdpts)) - !newfld=0.0 - !newfld=unpack(lgfld%fld,lgfld%bmap,newfld) - n=1 - do j=1,gfld%ngrdpts - if ( gfld%bmap(j) ) then - newfld(j)=gfld%fld(n) - n=n+1 - else - newfld(j)=0.0 - endif - enddo - deallocate(gfld%fld); - gfld%fld=>newfld; - gfld%expanded=.true. - else - gfld%expanded=.true. - endif -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2rp.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2rp.f deleted file mode 100755 index 0cabeb654f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2rp.f +++ /dev/null @@ -1,189 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2RP EXTRACTS A GRIB MESSAGE FROM A FILE -C PRGMMR: GILBERT ORG: W/NMC23 DATE: 2003-12-31 -C -C ABSTRACT: FIND AND EXTRACTS A GRIB MESSAGE FROM A FILE GIVEN THE -C INDEX FOR THE REQUESTED FIELD. -C THE GRIB MESSAGE RETURNED CAN CONTAIN ONLY THE REQUESTED FIELD -C (EXTRACT=.TRUE.). OR THE COMPLETE GRIB MESSAGE ORIGINALLY CONTAINING -C THE DESIRED FIELD CAN BE RETURNED (EXTRACT=.FALSE.) EVEN IF OTHER -C FIELDS WERE INCLUDED IN THE GRIB MESSAGE. -C IF THE GRIB FIELD IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 2003-12-31 GILBERT -C -C USAGE: CALL GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE. -C FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING -C THIS ROUTINE. -C CINDEX INDEX RECORD OF THE GRIB FILE ( SEE DOCBLOCK OF -C SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.) -C EXTRACT LOGICAL VALUE INDICATING WHETHER TO RETURN A GRIB2 -C MESSAGE WITH JUST THE REQUESTED FIELD, OR THE ENTIRE -C GRIB2 MESSAGE CONTAINING THE REQUESTED FIELD. -C .TRUE. = RETURN GRIB2 MESSAGE CONTAINING ONLY THE REQUESTED -C FIELD. -C .FALSE. = RETURN ENTIRE GRIB2 MESSAGE CONTAINING THE -C REQUESTED FIELD. -C -C OUTPUT ARGUMENTS: -C GRIBM RETURNED GRIB MESSAGE. -C LENG LENGTH OF RETURNED GRIB MESSAGE IN BYTES. -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 97 ERROR READING GRIB FILE -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C -C REMARKS: NONE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - - INTEGER,INTENT(IN) :: LUGB - CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*) - LOGICAL,INTENT(IN) :: EXTRACT - INTEGER,INTENT(OUT) :: LENG,IRET - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: GRIBM - - INTEGER,PARAMETER :: ZERO=0 - CHARACTER(LEN=1),ALLOCATABLE,DIMENSION(:) :: CSEC2,CSEC6,CSEC7 - CHARACTER(LEN=4) :: Ctemp - - IRET=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C EXTRACT GRIB MESSAGE FROM FILE - IF ( EXTRACT ) THEN - LEN0=16 - LEN8=4 - CALL GBYTE(CINDEX,ISKIP,4*8,4*8) ! BYTES TO SKIP IN FILE - CALL GBYTE(CINDEX,ISKP2,8*8,4*8) ! BYTES TO SKIP FOR section 2 - if ( iskp2 .gt. 0 ) then - CALL BAREAD(LUGB,ISKIP+ISKP2,4,LREAD,ctemp) - CALL GBYTE(Ctemp,LEN2,0,4*8) ! LENGTH OF SECTION 2 - ALLOCATE(csec2(len2)) - CALL BAREAD(LUGB,ISKIP+ISKP2,LEN2,LREAD,csec2) - else - LEN2=0 - endif - CALL GBYTE(CINDEX,LEN1,44*8,4*8) ! LENGTH OF SECTION 1 - IPOS=44+LEN1 - CALL GBYTE(CINDEX,LEN3,IPOS*8,4*8) ! LENGTH OF SECTION 3 - IPOS=IPOS+LEN3 - CALL GBYTE(CINDEX,LEN4,IPOS*8,4*8) ! LENGTH OF SECTION 4 - IPOS=IPOS+LEN4 - CALL GBYTE(CINDEX,LEN5,IPOS*8,4*8) ! LENGTH OF SECTION 5 - IPOS=IPOS+LEN5 - CALL GBYTE(CINDEX,LEN6,IPOS*8,4*8) ! LENGTH OF SECTION 6 - IPOS=IPOS+5 - CALL GBYTE(CINDEX,IBMAP,IPOS*8,1*8) ! Bitmap indicator - IF ( IBMAP .eq. 254 ) THEN - CALL GBYTE(CINDEX,ISKP6,24*8,4*8) ! BYTES TO SKIP FOR section 6 - CALL BAREAD(LUGB,ISKIP+ISKP6,4,LREAD,ctemp) - CALL GBYTE(Ctemp,LEN6,0,4*8) ! LENGTH OF SECTION 6 - ENDIF - ! - ! READ IN SECTION 7 from file - ! - CALL GBYTE(CINDEX,ISKP7,28*8,4*8) ! BYTES TO SKIP FOR section 7 - CALL BAREAD(LUGB,ISKIP+ISKP7,4,LREAD,ctemp) - CALL GBYTE(Ctemp,LEN7,0,4*8) ! LENGTH OF SECTION 7 - ALLOCATE(csec7(len7)) - CALL BAREAD(LUGB,ISKIP+ISKP7,LEN7,LREAD,csec7) - - LENG=LEN0+LEN1+LEN2+LEN3+LEN4+LEN5+LEN6+LEN7+LEN8 - IF (.NOT. ASSOCIATED(GRIBM)) ALLOCATE(GRIBM(LENG)) - - ! Create Section 0 - ! - GRIBM(1)='G' - GRIBM(2)='R' - GRIBM(3)='I' - GRIBM(4)='B' - GRIBM(5)=CHAR(0) - GRIBM(6)=CHAR(0) - GRIBM(7)=CINDEX(42) - GRIBM(8)=CINDEX(41) - GRIBM(9)=CHAR(0) - GRIBM(10)=CHAR(0) - GRIBM(11)=CHAR(0) - GRIBM(12)=CHAR(0) - CALL SBYTE(GRIBM,LENG,12*8,4*8) - ! - ! Copy Section 1 - ! - GRIBM(17:16+LEN1)=CINDEX(45:44+LEN1) - lencur=16+LEN1 - ipos=44+len1 - ! - ! Copy Section 2, if necessary - ! - if ( iskp2 .gt. 0 ) then - GRIBM(lencur+1:lencur+LEN2)=csec2(1:LEN2) - lencur=lencur+LEN2 - endif - ! - ! Copy Sections 3 through 5 - ! - GRIBM(lencur+1:lencur+LEN3+LEN4+LEN5)= - & CINDEX(ipos+1:ipos+LEN3+LEN4+LEN5) - lencur=lencur+LEN3+LEN4+LEN5 - ipos=ipos+LEN3+LEN4+LEN5 - ! - ! Copy Section 6 - ! - if ( LEN6 .eq. 6 .AND. IBMAP .ne. 254 ) then - GRIBM(lencur+1:lencur+LEN6)=CINDEX(ipos+1:ipos+LEN6) - lencur=lencur+LEN6 - else - CALL GBYTE(CINDEX,ISKP6,24*8,4*8) ! BYTES TO SKIP FOR section 6 - CALL BAREAD(LUGB,ISKIP+ISKP6,4,LREAD,ctemp) - CALL GBYTE(Ctemp,LEN6,0,4*8) ! LENGTH OF SECTION 6 - ALLOCATE(csec6(len6)) - CALL BAREAD(LUGB,ISKIP+ISKP6,LEN6,LREAD,csec6) - GRIBM(lencur+1:lencur+LEN6)=csec6(1:LEN6) - lencur=lencur+LEN6 - IF ( allocated(csec6)) DEALLOCATE(csec6) - endif - ! - ! Copy Section 7 - ! - GRIBM(lencur+1:lencur+LEN7)=csec7(1:LEN7) - lencur=lencur+LEN7 - ! - ! Section 8 - ! - GRIBM(lencur+1)='7' - GRIBM(lencur+2)='7' - GRIBM(lencur+3)='7' - GRIBM(lencur+4)='7' - - ! clean up - ! - IF ( allocated(csec2)) DEALLOCATE(csec2) - IF ( allocated(csec7)) deallocate(csec7) - - ELSE ! DO NOT extract field from message : Get entire message - - CALL GBYTE(CINDEX,ISKIP,4*8,4*8) ! BYTES TO SKIP IN FILE - CALL GBYTE(CINDEX,LENG,36*8,4*8) ! LENGTH OF GRIB MESSAGE - IF (.NOT. ASSOCIATED(GRIBM)) ALLOCATE(GRIBM(LENG)) - CALL BAREAD(LUGB,ISKIP,LENG,LREAD,GRIBM) - IF ( LENG .NE. LREAD ) THEN - DEALLOCATE(GRIBM) - NULLIFY(GRIBM) - IRET=97 - RETURN - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2s.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2s.f deleted file mode 100755 index e129c517e5..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getgb2s.f +++ /dev/null @@ -1,489 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN, - & JGDT,K,GFLD,LPOS,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2S FINDS A GRIB MESSAGE -C PRGMMR: GILBERT ORG: W/NP11 DATE: 02-01-15 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C FIND IN THE INDEX FILE A REFERENCE TO THE GRIB FIELD REQUESTED. -C THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND -C PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER -C OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C -C EACH INDEX RECORD HAS THE FOLLOWING FORM: -C BYTE 001 - 004: LENGTH OF INDEX RECORD -C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE) -C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE. -C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS -C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS -C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS -C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION -C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE -C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 ) -C BYTE 042 - 042: MESSAGE DISCIPLINE -C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE -C BYTE 045 - II: IDENTIFICATION SECTION (IDS) -C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS) -C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS) -C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS) -C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS) -C -C Most of the decoded information for the selected GRIB field -C is returned in a derived type variable, gfld. -C Gfld is of type gribfield, which is defined -C in module grib_mod, so users of this routine will need to include -C the line "USE GRIB_MOD" in their calling routine. Each component of the -C gribfield type is described in the OUTPUT ARGUMENT LIST section below. -C Only the unpacked bitmap and data field components are not set by this -C routine. -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 2002-01-02 GILBERT MODIFIED FROM GETG1S TO WORK WITH GRIB2 -C -C USAGE: CALL GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN, -C & JGDT,K,GFLD,LPOS,IRET) -C INPUT ARGUMENTS: -C CBUF CHARACTER*1 (NLEN) BUFFER CONTAINING INDEX DATA -C NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS -C NNUM INTEGER NUMBER OF INDEX RECORDS -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD -C ( IF = -1, ACCEPT ANY DISCIPLINE) -C ( SEE CODE TABLE 0.0 ) -C 0 - Meteorological products -C 1 - Hydrological products -C 2 - Land surface products -C 3 - Space products -C 10 - Oceanographic products -C JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION -C (=-9999 FOR WILDCARD) -C JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE -C ( SEE COMMON CODE TABLE C-1 ) -C JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE -C JIDS(3) = GRIB MASTER TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C JIDS(6) = YEAR ( 4 DIGITS ) -C JIDS(7) = MONTH -C JIDS(8) = DAY -C JIDS(9) = HOUR -C JIDS(10) = MINUTE -C JIDS(11) = SECOND -C JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA -C ( SEE CODE TABLE 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N) -C ( IF = -1, DON'T BOTHER MATCHING PDT ) -C JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION -C TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M) -C ( IF = -1, DON'T BOTHER MATCHING GDT ) -C JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION -C TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C OUTPUT ARGUMENTS: -C K INTEGER MESSAGE NUMBER FOUND -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C gfld - derived type gribfield ( defined in module grib_mod ) -C ( NOTE: See Remarks Section ) -C gfld%version = GRIB edition number ( currently 2 ) -C gfld%discipline = Message Discipline ( see Code Table 0.0 ) -C gfld%idsect() = Contains the entries in the Identification -C Section ( Section 1 ) -C This element is actually a pointer to an array -C that holds the data. -C gfld%idsect(1) = Identification of originating Centre -C ( see Common Code Table C-1 ) -C 7 - US National Weather Service -C gfld%idsect(2) = Identification of originating Sub-centre -C gfld%idsect(3) = GRIB Master Tables Version Number -C ( see Code Table 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C gfld%idsect(4) = GRIB Local Tables Version Number -C ( see Code Table 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C gfld%idsect(6) = Year ( 4 digits ) -C gfld%idsect(7) = Month -C gfld%idsect(8) = Day -C gfld%idsect(9) = Hour -C gfld%idsect(10) = Minute -C gfld%idsect(11) = Second -C gfld%idsect(12) = Production status of processed data -C ( see Code Table 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C gfld%idsectlen = Number of elements in gfld%idsect(). -C gfld%local() = Pointer to character array containing contents -C of Local Section 2, if included -C gfld%locallen = length of array gfld%local() -C gfld%ifldnum = field number within GRIB message -C gfld%griddef = Source of grid definition (see Code Table 3.0) -C 0 - Specified in Code table 3.1 -C 1 - Predetermined grid Defined by originating centre -C gfld%ngrdpts = Number of grid points in the defined grid. -C gfld%numoct_opt = Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C gfld%interp_opt = Interpretation of list for optional points -C definition. (Code Table 3.11) -C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -C gfld%igdtmpl() = Contains the data values for the specified Grid -C Definition Template ( NN=gfld%igdtnum ). Each -C element of this integer array contains an entry (in -C the order specified) of Grid Defintion Template 3.NN -C This element is actually a pointer to an array -C that holds the data. -C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -C entries in Grid Defintion Template 3.NN -C ( NN=gfld%igdtnum ). -C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -C contains the number of grid points contained in -C each row ( or column ). (part of Section 3) -C This element is actually a pointer to an array -C that holds the data. This pointer is nullified -C if gfld%numoct_opt=0. -C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -C in array ideflist. i.e. number of rows ( or columns ) -C for which optional grid points are defined. This value -C is set to zero, if gfld%numoct_opt=0. -C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -C gfld%ipdtmpl() = Contains the data values for the specified Product -C Definition Template ( N=gfdl%ipdtnum ). Each element -C of this integer array contains an entry (in the -C order specified) of Product Defintion Template 4.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -C entries in Product Defintion Template 4.N -C ( N=gfdl%ipdtnum ). -C gfld%coord_list() = Real array containing floating point values -C intended to document the vertical discretisation -C associated to model data on hybrid coordinate -C vertical levels. (part of Section 4) -C This element is actually a pointer to an array -C that holds the data. -C gfld%num_coord = number of values in array gfld%coord_list(). -C gfld%ndpts = Number of data points unpacked and returned. -C gfld%idrtnum = Data Representation Template Number -C ( see Code Table 5.0) -C gfld%idrtmpl() = Contains the data values for the specified Data -C Representation Template ( N=gfld%idrtnum ). Each -C element of this integer array contains an entry -C (in the order specified) of Product Defintion -C Template 5.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -C of entries in Data Representation Template 5.N -C ( N=gfld%idrtnum ). -C gfld%unpacked = logical value indicating whether the bitmap and -C data values were unpacked. If false, -C gfld%bmap and gfld%fld pointers are nullified. -C NOTE: This routine sets this component to .FALSE. -C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -C 0 = bitmap applies and is included in Section 6. -C 1-253 = Predefined bitmap applies -C 254 = Previously defined bitmap applies to this field -C 255 = Bit map does not apply to this product. -C gfld%bmap() = Logical*1 array containing decoded bitmap, -C if ibmap=0 or ibap=254. Otherwise nullified. -C This element is actually a pointer to an array -C that holds the data. -C NOTE: This component is not set by this routine. -C gfld%fld() = Array of gfld%ndpts unpacked data points. -C This element is actually a pointer to an array -C that holds the data. -C NOTE: This component is not set by this routine. -C LPOS STARTING POSITION OF THE FOUND INDEX RECORD WITHIN -C THE COMPLETE INDEX BUFFER, CBUF. -C = 0, IF REQUEST NOT FOUND -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 1 REQUEST NOT FOUND -C -C REMARKS: -C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY. -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C SUBPROGRAMS CALLED: -C GBYTE UNPACK BYTES -C GF_UNPACK1 UNPACK IDS -C GF_UNPACK4 UNPACK PDS -C GF_UNPACK3 UNPACK GDS -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE GRIB_MOD - -! CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - CHARACTER(LEN=1),INTENT(IN) :: CBUF(NLEN) - INTEGER,INTENT(IN) :: NLEN,NNUM,J,JDISC,JPDTN,JGDTN - INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*) - INTEGER,INTENT(OUT) :: K,LPOS,IRET - TYPE(GRIBFIELD),INTENT(OUT) :: GFLD - - INTEGER :: KGDS(5) - LOGICAL :: MATCH1,MATCH3,MATCH4 -! INTEGER,POINTER,DIMENSION(:) :: KIDS,KPDT,KGDT -! INTEGER,POINTER,DIMENSION(:) :: IDEF -! REAL,POINTER,DIMENSION(:) :: COORD - - interface - subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: ids - integer,intent(out) :: ierr,idslen - end subroutine gf_unpack1 - subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, - & mapgridlen,ideflist,idefnum,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: igdstmpl,ideflist - integer,intent(out) :: igds(5) - integer,intent(out) :: ierr,idefnum - end subroutine gf_unpack3 - subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl, - & mappdslen,coordlist,numcoord,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - real,pointer,dimension(:) :: coordlist - integer,pointer,dimension(:) :: ipdstmpl - integer,intent(out) :: ipdsnum - integer,intent(out) :: ierr,numcoord - end subroutine gf_unpack4 - subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum, - & idrstmpl,mapdrslen,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: ndpts,idrsnum - integer,pointer,dimension(:) :: idrstmpl - integer,intent(out) :: ierr - end subroutine gf_unpack5 - end interface - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C INITIALIZE - K=0 - LPOS=0 - IRET=1 - IPOS=0 - nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl) - nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH FOR REQUEST - DOWHILE(IRET.NE.0.AND.K.LT.NNUM) - K=K+1 - CALL GBYTE(CBUF,INLEN,IPOS*8,4*8) ! GET LENGTH OF CURRENT - ! INDEX RECORD - IF ( K.LE.J ) THEN ! SKIP THIS INDEX - IPOS=IPOS+INLEN - CYCLE - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CHECK IF GRIB2 DISCIPLINE IS A MATCH - CALL GBYTE(CBUF,GFLD%DISCIPLINE,(IPOS+41)*8,1*8) - IF ( (JDISC.NE.-1).AND.(JDISC.NE.GFLD%DISCIPLINE) ) THEN - IPOS=IPOS+INLEN - CYCLE - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CHECK IF IDENTIFICATION SECTION IS A MATCH - MATCH1=.FALSE. - CALL GBYTE(CBUF,LSEC1,(IPOS+44)*8,4*8) ! GET LENGTH OF IDS - IOF=0 - CALL GF_UNPACK1(CBUF(IPOS+45),LSEC1,IOF,GFLD%IDSECT, - & GFLD%IDSECTLEN,ICND) - IF ( ICND.EQ.0 ) THEN - MATCH1=.TRUE. - DO I=1,GFLD%IDSECTLEN - IF ( (JIDS(I).NE.-9999).AND. - & (JIDS(I).NE.GFLD%IDSECT(I)) ) THEN - MATCH1=.FALSE. - EXIT - ENDIF - ENDDO - ENDIF - IF ( .NOT. MATCH1 ) THEN - DEALLOCATE(GFLD%IDSECT) - IPOS=IPOS+INLEN - CYCLE - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CHECK IF GRID DEFINITION TEMPLATE IS A MATCH - JPOS=IPOS+44+LSEC1 - MATCH3=.FALSE. - CALL GBYTE(CBUF,LSEC3,JPOS*8,4*8) ! GET LENGTH OF GDS - IF ( JGDTN.EQ.-1 ) THEN - MATCH3=.TRUE. - ELSE - CALL GBYTE(CBUF,NUMGDT,(JPOS+12)*8,2*8) ! GET GDT TEMPLATE NO. - IF ( JGDTN.EQ.NUMGDT ) THEN - IOF=0 - CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL, - & GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND) - IF ( ICND.EQ.0 ) THEN - MATCH3=.TRUE. - DO I=1,GFLD%IGDTLEN - IF ( (JGDT(I).NE.-9999).AND. - & (JGDT(I).NE.GFLD%IGDTMPL(I)) ) THEN - MATCH3=.FALSE. - EXIT - ENDIF - ENDDO -C WHERE ( JGDT(1:GFLD%IGDTLEN).NE.-9999 ) -C & MATCH3=ALL(JGDT(1:GFLD%IGDTLEN).EQ.GFLD%IGDTMPL(1:GFLD%IGDTLEN)) - ENDIF - ENDIF - ENDIF - IF ( .NOT. MATCH3 ) THEN - IF (ASSOCIATED(GFLD%IGDTMPL)) DEALLOCATE(GFLD%IGDTMPL) - IF (ASSOCIATED(GFLD%LIST_OPT)) DEALLOCATE(GFLD%LIST_OPT) - IPOS=IPOS+INLEN - CYCLE - ELSE - GFLD%GRIDDEF=KGDS(1) - GFLD%NGRDPTS=KGDS(2) - GFLD%NUMOCT_OPT=KGDS(3) - GFLD%INTERP_OPT=KGDS(4) - GFLD%IGDTNUM=KGDS(5) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CHECK IF PRODUCT DEFINITION TEMPLATE IS A MATCH - JPOS=JPOS+LSEC3 - MATCH4=.FALSE. - CALL GBYTE(CBUF,LSEC4,JPOS*8,4*8) ! GET LENGTH OF PDS - IF ( JPDTN.EQ.-1 ) THEN - MATCH4=.TRUE. - ELSE - CALL GBYTE(CBUF,NUMPDT,(JPOS+7)*8,2*8) ! GET PDT TEMPLATE NO. - IF ( JPDTN.EQ.NUMPDT ) THEN - IOF=0 - CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM, - & GFLD%IPDTMPL,GFLD%IPDTLEN, - & GFLD%COORD_LIST,GFLD%NUM_COORD,ICND) - IF ( ICND.EQ.0 ) THEN - MATCH4=.TRUE. - DO I=1,GFLD%IPDTLEN - IF ( (JPDT(I).NE.-9999).AND. - & (JPDT(I).NE.GFLD%IPDTMPL(I)) ) THEN - MATCH4=.FALSE. - EXIT - ENDIF - ENDDO -c WHERE ( JPDT.NE.-9999) -c & MATCH4=ALL( JPDT(1:GFLD%IPDTLEN) .EQ. GFLD%IPDTMPL(1:GFLD%IPDTLEN) ) - ENDIF - ENDIF - ENDIF - IF ( .NOT. MATCH4 ) THEN - IF (ASSOCIATED(GFLD%IPDTMPL)) DEALLOCATE(GFLD%IPDTMPL) - IF (ASSOCIATED(GFLD%COORD_LIST)) DEALLOCATE(GFLD%COORD_LIST) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C IF REQUEST IS FOUND -C SET VALUES FOR DERIVED TYPE GFLD AND RETURN - IF(MATCH1.AND.MATCH3.AND.MATCH4) THEN - LPOS=IPOS+1 - CALL GBYTE(CBUF,GFLD%VERSION,(IPOS+40)*8,1*8) - CALL GBYTE(CBUF,GFLD%IFLDNUM,(IPOS+42)*8,2*8) - GFLD%UNPACKED=.FALSE. - JPOS=IPOS+44+LSEC1 - IF ( JGDTN.EQ.-1 ) THEN ! UNPACK GDS, IF NOT DONE BEFORE - IOF=0 - CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL, - & GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND) - GFLD%GRIDDEF=KGDS(1) - GFLD%NGRDPTS=KGDS(2) - GFLD%NUMOCT_OPT=KGDS(3) - GFLD%INTERP_OPT=KGDS(4) - GFLD%IGDTNUM=KGDS(5) - ENDIF - JPOS=JPOS+LSEC3 - IF ( JPDTN.EQ.-1 ) THEN ! UNPACK PDS, IF NOT DONE BEFORE - IOF=0 - CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM, - & GFLD%IPDTMPL,GFLD%IPDTLEN, - & GFLD%COORD_LIST,GFLD%NUM_COORD,ICND) - ENDIF - JPOS=JPOS+LSEC4 - CALL GBYTE(CBUF,LSEC5,JPOS*8,4*8) ! GET LENGTH OF DRS - IOF=0 - CALL GF_UNPACK5(CBUF(JPOS+1),LSEC5,IOF,GFLD%NDPTS, - & GFLD%IDRTNUM,GFLD%IDRTMPL, - & GFLD%IDRTLEN,ICND) - JPOS=JPOS+LSEC5 - CALL GBYTE(CBUF,GFLD%IBMAP,(JPOS+5)*8,1*8) ! GET IBMAP - IRET=0 - ELSE ! PDT DID NOT MATCH - IPOS=IPOS+INLEN - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getidx.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getidx.f deleted file mode 100755 index d4427b7b27..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getidx.f +++ /dev/null @@ -1,143 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETIDX FINDS, READS OR GENERATES A GRIB2 INDEX -C PRGMMR: GILBERT ORG: W/NP11 DATE: 2005-03-15 -C -C ABSTRACT: FINDS, READS OR GENERATES A GRIB2 INDEX FOR THE GRIB2 FILE -C ASSOCIATED WITH UNIT LUGB. IF THE INDEX ALREADY EXISTS, IT IS RETURNED. -C OTHERWISE, THE INDEX IS (1) READ FROM AN EXISTING INDEXFILE ASSOCIATED WITH -C UNIT LUGI. OR (2) GENERATED FROM THE GRIB2FILE LUGB ( IF LUGI=0 ). -C USERS CAN FORCE A REGENERATION OF AN INDEX. IF LUGI EQUALS LUGB, THE INDEX -C WILL BE REGENERATED FROM THE DATA IN FILE LUGB. IF LUGI IS LESS THAN -C ZERO, THEN THE INDEX IS RE READ FROM INDEX FILE ABS(LUGI). -C -C PROGRAM HISTORY LOG: -C 2005-03-15 GILBERT -C -C USAGE: CALL GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET) -C -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE. -C FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING -C THIS ROUTINE. -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE. -C IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE -C CALLING THIS ROUTINE. -C >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T -C ALREADY EXIST. -C =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX -C DOESN"T ALREADY EXIST. -C <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI). -C =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB. -C -C OUTPUT ARGUMENTS: -C CINDEX CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS. -C NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS -C NNUM INTEGER NUMBER OF INDEX RECORDS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 90 UNIT NUMBER OUT OF RANGE -C 96 ERROR READING/CREATING INDEX FILE -C -C SUBPROGRAMS CALLED: -C GETG2I READ INDEX FILE -C GETG2IR READ INDEX BUFFER FROM GRIB FILE -C -C REMARKS: -C -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - - INTEGER,INTENT(IN) :: LUGB,LUGI - INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CINDEX - - INTEGER,PARAMETER :: MAXIDX=100 - INTEGER,PARAMETER :: MSK1=32000,MSK2=4000 - - TYPE GINDEX - integer :: nlen - integer :: nnum - character(len=1),pointer,dimension(:) :: cbuf - END TYPE GINDEX - - TYPE(GINDEX),SAVE :: IDXLIST(100) - - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DECLARE INTERFACES (REQUIRED FOR CBUF POINTER) - INTERFACE - SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGI - INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET - END SUBROUTINE GETG2I - SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM, - & NMESS,IRET) - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM - INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET - END SUBROUTINE GETG2IR - END INTERFACE - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - LUX=0 - IRET=0 - IF ( LUGB.LE.0 .AND. LUGB.GT.100 ) THEN - IRET=90 - RETURN - ENDIF - IF (LUGI.EQ.LUGB) THEN ! Force regeneration of index from GRIB2 File - IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) - & DEALLOCATE(IDXLIST(LUGB)%CBUF) - NULLIFY(IDXLIST(LUGB)%CBUF) - IDXLIST(LUGB)%NLEN=0 - IDXLIST(LUGB)%NNUM=0 - LUX=0 - ENDIF - IF (LUGI.LT.0) THEN ! Force re-read of index from indexfile - ! associated with unit abs(lugi) - IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) - & DEALLOCATE(IDXLIST(LUGB)%CBUF) - NULLIFY(IDXLIST(LUGB)%CBUF) - IDXLIST(LUGB)%NLEN=0 - IDXLIST(LUGB)%NNUM=0 - LUX=ABS(LUGI) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C Check if index already exists in memory - IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) THEN - CINDEX => IDXLIST(LUGB)%CBUF - NLEN = IDXLIST(LUGB)%NLEN - NNUM = IDXLIST(LUGB)%NNUM - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRGI=0 - IF(LUX.GT.0) THEN - CALL GETG2I(LUX,IDXLIST(LUGB)%CBUF,NLEN,NNUM,IRGI) - ELSEIF(LUX.LE.0) THEN - MSKP=0 - CALL GETG2IR(LUGB,MSK1,MSK2,MSKP,IDXLIST(LUGB)%CBUF, - & NLEN,NNUM,NMESS,IRGI) - ENDIF - IF(IRGI.EQ.0) THEN - CINDEX => IDXLIST(LUGB)%CBUF - IDXLIST(LUGB)%NLEN = NLEN - IDXLIST(LUGB)%NNUM = NNUM - ELSE - NLEN = 0 - NNUM = 0 - IRET=96 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getlocal.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getlocal.f deleted file mode 100755 index d82180ee82..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getlocal.f +++ /dev/null @@ -1,168 +0,0 @@ - subroutine getlocal(cgrib,lcgrib,localnum,csec2,lcsec2,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getlocal -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25 -! -! ABSTRACT: This subroutine returns the contents of Section 2 ( Local -! Use Section ) from a GRIB2 message. Since there can be multiple -! occurrences of Section 2 within a GRIB message, the calling routine -! indicates which occurrence is being requested with the localnum argument. -! -! PROGRAM HISTORY LOG: -! 2000-05-25 Gilbert -! -! USAGE: CALL getlocal(cgrib,lcgrib,localnum,csec2,lcsec2,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message in array cgrib. -! localnum - The nth occurrence of Section 2 requested. -! -! OUTPUT ARGUMENT LIST: -! csec2 - Character array containing information read from -! Section 2. -! The dimension of this array can be obtained in advance -! from argument maxlocal, which is returned from subroutine -! gb_info. -! lcsec2 - Number of bytes of character array csec2 read from -! Section 2. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = The section 2 request number was not positive. -! 4 = End string "7777" found, but not where expected. -! 5 = End string "7777" not found at end of message. -! 6 = GRIB message did not contain the requested number of -! Local Use Sections. -! -! REMARKS: Note that subroutine gb_info can be used to first determine -! how many Local Use sections exist in a given GRIB message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,localnum - character(len=1),intent(out) :: csec2(*) - integer,intent(out) :: lcsec2,ierr - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4) :: ctemp - integer :: listsec0(2) - integer iofst,ibeg,istart,numlocal - - ierr=0 - numlocal=0 -! -! Check for valid request number -! - if (localnum.le.0) then - print *,'getlocal: Request for local section must be positive.' - ierr=3 - return - endif -! -! Check for beginning of GRIB message in the first 100 bytes -! - istart=0 - do j=1,100 - ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3) - if (ctemp.eq.grib ) then - istart=j - exit - endif - enddo - if (istart.eq.0) then - print *,'getlocal: Beginning characters GRIB not found.' - ierr=1 - return - endif -! -! Unpack Section 0 - Indicator Section -! - iofst=8*(istart+5) - call gbyte(cgrib,listsec0(1),iofst,8) ! Discipline - iofst=iofst+8 - call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number - iofst=iofst+8 - iofst=iofst+32 - call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message - iofst=iofst+32 - lensec0=16 - ipos=istart+lensec0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'getlocal: can only decode GRIB edition 2.' - ierr=2 - return - endif -! -! Loop through the remaining sections keeping track of the -! length of each. Also check to see that if the current occurrence -! of Section 2 is the same as the one requested. -! - do - ! Check to see if we are at end of GRIB message - ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3) - if (ctemp.eq.c7777 ) then - ipos=ipos+4 - ! If end of GRIB message not where expected, issue error - if (ipos.ne.(istart+lengrib)) then - print *,'getlocal: "7777" found, but not where expected.' - ierr=4 - return - endif - exit - endif - ! Get length of Section and Section number - iofst=(ipos-1)*8 - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section number - iofst=iofst+8 - ! If found the requested occurrence of Section 2, - ! return the section contents. - if (isecnum.eq.2) then - numlocal=numlocal+1 - if (numlocal.eq.localnum) then - lcsec2=lensec-5 - csec2(1:lcsec2)=cgrib(ipos+5:ipos+lensec-1) - return - endif - endif - ! Check to see if we read pass the end of the GRIB - ! message and missed the terminator string '7777'. - ipos=ipos+lensec ! Update beginning of section pointer - if (ipos.gt.(istart+lengrib)) then - print *,'getlocal: "7777" not found at end of GRIB message.' - ierr=5 - return - endif - - enddo - -! -! If exited from above loop, the end of the GRIB message was reached -! before the requested occurrence of section 2 was found. -! - print *,'getlocal: GRIB message contained ',numlocal, - & ' local sections.' - print *,'getlocal: The request was for the ',localnum, - & ' occurrence.' - ierr=6 - - return - end - - - - - - - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getpoly.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getpoly.f deleted file mode 100755 index f8d22f3ab3..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/getpoly.f +++ /dev/null @@ -1,80 +0,0 @@ - subroutine getpoly(csec3,lcsec3,jj,kk,mm) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getpoly -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-11 -! -! ABSTRACT: This subroutine returns the J, K, and M pentagonal resolution -! parameters specified in a GRIB Grid Definition Section used -! spherical harmonic coefficients using GDT 5.50 through 5.53 -! -! PROGRAM HISTORY LOG: -! 2002-12-11 Gilbert -! -! USAGE: CALL getpoly(csec3,lcsec3,jj,kk,mm) -! INPUT ARGUMENT LIST: -! csec3 - Character array that contains the packed GRIB2 GDS -! lcsec3 - Length (in octets) of section 3 -! -! OUTPUT ARGUMENT LIST: -! JJ = J - pentagonal resolution parameter -! KK = K - pentagonal resolution parameter -! MM = M - pentagonal resolution parameter -! -! REMARKS: Returns JJ, KK, and MM set to zero, if grid template -! not recognized. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ -! use grib_mod - - character(len=1),intent(in) :: csec3(*) - integer,intent(in) :: lcsec3 - integer,intent(out) :: jj,kk,mm - - integer,pointer,dimension(:) :: igdstmpl,list_opt - integer :: igds(5) - integer iofst,igdtlen,num_opt,jerr - - interface - subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, - & mapgridlen,ideflist,idefnum,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: igdstmpl,ideflist - integer,intent(out) :: igds(5) - integer,intent(out) :: ierr,idefnum - end subroutine gf_unpack3 - end interface - - nullify(igdstmpl,list_opt) - ! - iofst=0 ! set offset to beginning of section - call gf_unpack3(csec3,lcsec3,iofst,igds,igdstmpl, - & igdtlen,list_opt,num_opt,jerr) - if (jerr.eq.0) then - selectcase( igds(5) ) ! Template number - case (50:53) ! Spherical harmonic coefficients - jj=igdstmpl(1) - kk=igdstmpl(2) - mm=igdstmpl(3) - case default - jj=0 - kk=0 - mm=0 - end select - else - jj=0 - kk=0 - mm=0 - endif - ! - if (associated(igdstmpl)) deallocate(igdstmpl) - if (associated(list_opt)) deallocate(list_opt) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gettemplates.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gettemplates.f deleted file mode 100755 index d421a1afeb..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gettemplates.f +++ /dev/null @@ -1,244 +0,0 @@ - subroutine gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl, - & igdslen,ideflist,idefnum,ipdsnum,ipdstmpl, - & ipdslen,coordlist,numcoord,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gettemplates -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine returns the Grid Definition, and -! Product Definition for a given data -! field. Since there can be multiple data fields packed into a GRIB2 -! message, the calling routine indicates which field is being requested -! with the ifldnum argument. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen, -! & ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen, -! & coordlist,numcoord,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! ifldnum - Specifies which field in the GRIB2 message to return. -! -! OUTPUT ARGUMENT LIST: -! igds - Contains information read from the appropriate GRIB Grid -! Definition Section 3 for the field being returned. -! Must be dimensioned >= 5. -! igds(1)=Source of grid definition (see Code Table 3.0) -! igds(2)=Number of grid points in the defined grid. -! igds(3)=Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! igds(4)=Interpretation of list for optional points -! definition. (Code Table 3.11) -! igds(5)=Grid Definition Template Number (Code Table 3.1) -! igdstmpl - Contains the data values for the specified Grid Definition -! Template ( NN=igds(5) ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Defintion Template 3.NN -! A safe dimension for this array can be obtained in advance -! from maxvals(2), which is returned from subroutine gribinfo. -! igdslen - Number of elements in igdstmpl(). i.e. number of entries -! in Grid Defintion Template 3.NN ( NN=igds(5) ). -! ideflist - (Used if igds(3) .ne. 0) This array contains the -! number of grid points contained in each row ( or column ). -! (part of Section 3) -! A safe dimension for this array can be obtained in advance -! from maxvals(3), which is returned from subroutine gribinfo. -! idefnum - (Used if igds(3) .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. -! ipdsnum - Product Definition Template Number ( see Code Table 4.0) -! ipdstmpl - Contains the data values for the specified Product Definition -! Template ( N=ipdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 4.N -! A safe dimension for this array can be obtained in advance -! from maxvals(4), which is returned from subroutine gribinfo. -! ipdslen - Number of elements in ipdstmpl(). i.e. number of entries -! in Product Defintion Template 4.N ( N=ipdsnum ). -! coordlist- Array containg floating point values intended to document -! the vertical discretisation associated to model data -! on hybrid coordinate vertical levels. (part of Section 4) -! The dimension of this array can be obtained in advance -! from maxvals(5), which is returned from subroutine gribinfo. -! numcoord - number of values in array coordlist. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = The data field request number was not positive. -! 4 = End string "7777" found, but not where expected. -! 6 = GRIB message did not contain the requested number of -! data fields. -! 7 = End string "7777" not found at end of message. -! 10 = Error unpacking Section 3. -! 11 = Error unpacking Section 4. -! -! REMARKS: Note that subroutine gribinfo can be used to first determine -! how many data fields exist in the given GRIB message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ifldnum - integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*) - integer,intent(out) :: ipdsnum,ipdstmpl(*) - integer,intent(out) :: idefnum,numcoord - integer,intent(out) :: ierr - real,intent(out) :: coordlist(*) - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4) :: ctemp - integer:: listsec0(2) - integer iofst,ibeg,istart - logical have3,have4 - - have3=.false. - have4=.false. - ierr=0 - numfld=0 -! -! Check for valid request number -! - if (ifldnum.le.0) then - print *,'gettemplates: Request for field number must be ', - & 'positive.' - ierr=3 - return - endif -! -! Check for beginning of GRIB message in the first 100 bytes -! - istart=0 - do j=1,100 - ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3) - if (ctemp.eq.grib ) then - istart=j - exit - endif - enddo - if (istart.eq.0) then - print *,'gettemplates: Beginning characters GRIB not found.' - ierr=1 - return - endif -! -! Unpack Section 0 - Indicator Section -! - iofst=8*(istart+5) - call gbyte(cgrib,listsec0(1),iofst,8) ! Discipline - iofst=iofst+8 - call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number - iofst=iofst+8 - iofst=iofst+32 - call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message - iofst=iofst+32 - lensec0=16 - ipos=istart+lensec0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'gettemplates: can only decode GRIB edition 2.' - ierr=2 - return - endif -! -! Loop through the remaining sections keeping track of the -! length of each. Also keep the latest Grid Definition Section info. -! Unpack the requested field number. -! - do - ! Check to see if we are at end of GRIB message - ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3) - if (ctemp.eq.c7777 ) then - ipos=ipos+4 - ! If end of GRIB message not where expected, issue error - if (ipos.ne.(istart+lengrib)) then - print *,'gettemplates: "7777" found, but not where ', - & 'expected.' - ierr=4 - return - endif - exit - endif - ! Get length of Section and Section number - iofst=(ipos-1)*8 - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section number - iofst=iofst+8 - !print *,' lensec= ',lensec,' secnum= ',isecnum - ! - ! If found Section 3, unpack the GDS info using the - ! appropriate template. Save in case this is the latest - ! grid before the requested field. - ! - if (isecnum.eq.3) then - iofst=iofst-40 ! reset offset to beginning of section - call unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,igdslen, - & ideflist,idefnum,jerr) - if (jerr.eq.0) then - have3=.true. - else - ierr=10 - return - endif - endif - ! - ! If found Section 4, check to see if this field is the - ! one requested. - ! - if (isecnum.eq.4) then - numfld=numfld+1 - if (numfld.eq.ifldnum) then - iofst=iofst-40 ! reset offset to beginning of section - call unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,ipdslen, - & coordlist,numcoord,jerr) - if (jerr.eq.0) then - have4=.true. - else - ierr=11 - return - endif - endif - endif - ! - ! Check to see if we read pass the end of the GRIB - ! message and missed the terminator string '7777'. - ! - ipos=ipos+lensec ! Update beginning of section pointer - if (ipos.gt.(istart+lengrib)) then - print *,'gettemplates: "7777" not found at end of GRIB ', - & 'message.' - ierr=7 - return - endif - - if (have3.and.have4) return - - enddo - -! -! If exited from above loop, the end of the GRIB message was reached -! before the requested field was found. -! - print *,'gettemplates: GRIB message contained ',numlocal, - & ' different fields.' - print *,'gettemplates: The request was for the ',ifldnum, - & ' field.' - ierr=6 - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_free.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_free.f deleted file mode 100755 index 43fc6a4a11..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_free.f +++ /dev/null @@ -1,199 +0,0 @@ - subroutine gf_free(gfld) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_free -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine frees up memory that was used to store -! array values in derived type gribfield. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL gf_free(gfld) -! INPUT ARGUMENT LIST: -! gfld - derived type gribfield ( defined in module grib_mod ) -! -! OUTPUT ARGUMENT LIST: -! gfld - derived type gribfield ( defined in module grib_mod ) -! gfld%version = GRIB edition number -! gfld%discipline = Message Discipline ( see Code Table 0.0 ) -! gfld%idsect() = Contains the entries in the Identification -! Section ( Section 1 ) -! This element is actually a pointer to an array -! that holds the data. -! gfld%idsect(1) = Identification of originating Centre -! ( see Common Code Table C-1 ) -! gfld%idsect(2) = Identification of originating Sub-centre -! gfld%idsect(3) = GRIB Master Tables Version Number -! ( see Code Table 1.0 ) -! gfld%idsect(4) = GRIB Local Tables Version Number -! ( see Code Table 1.1 ) -! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -! gfld%idsect(6) = Year ( 4 digits ) -! gfld%idsect(7) = Month -! gfld%idsect(8) = Day -! gfld%idsect(9) = Hour -! gfld%idsect(10) = Minute -! gfld%idsect(11) = Second -! gfld%idsect(12) = Production status of processed data -! ( see Code Table 1.3 ) -! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -! gfld%idsectlen = Number of elements in gfld%idsect(). -! gfld%local() = Pointer to character array containing contents -! of Local Section 2, if included -! gfld%locallen = length of array gfld%local() -! gfld%ifldnum = field number within GRIB message -! gfld%griddef = Source of grid definition (see Code Table 3.0) -! gfld%ngrdpts = Number of grid points in the defined grid. -! gfld%numoct_opt = Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! gfld%interp_opt = Interpretation of list for optional points -! definition. (Code Table 3.11) -! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -! gfld%igdtmpl() = Contains the data values for the specified Grid -! Definition Template ( NN=gfld%igdtnum ). Each -! element of this integer array contains an entry (in -! the order specified) of Grid Defintion Template 3.NN -! This element is actually a pointer to an array -! that holds the data. -! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -! entries in Grid Defintion Template 3.NN -! ( NN=gfld%igdtnum ). -! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -! contains the number of grid points contained in -! each row ( or column ). (part of Section 3) -! This element is actually a pointer to an array -! that holds the data. This pointer is nullified -! if gfld%numoct_opt=0. -! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. This value -! is set to zero, if gfld%numoct_opt=0. -! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -! gfld%ipdtmpl() = Contains the data values for the specified Product -! Definition Template ( N=gfdl%ipdtnum ). Each element -! of this integer array contains an entry (in the -! order specified) of Product Defintion Template 4.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -! entries in Product Defintion Template 4.N -! ( N=gfdl%ipdtnum ). -! gfld%coord_list() = Real array containing floating point values -! intended to document the vertical discretisation -! associated to model data on hybrid coordinate -! vertical levels. (part of Section 4) -! This element is actually a pointer to an array -! that holds the data. -! gfld%num_coord = number of values in array gfld%coord_list(). -! gfld%ndpts = Number of data points unpacked and returned. -! gfld%idrtnum = Data Representation Template Number -! ( see Code Table 5.0) -! gfld%idrtmpl() = Contains the data values for the specified Data -! Representation Template ( N=gfld%idrtnum ). Each -! element of this integer array contains an entry -! (in the order specified) of Product Defintion -! Template 5.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -! of entries in Data Representation Template 5.N -! ( N=gfld%idrtnum ). -! gfld%unpacked = logical value indicating whether the bitmap and -! data values were unpacked. If false, gfld%ndpts -! is set to zero, and gfld%bmap and gfld%fld -! pointers are nullified. -! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! gfld%bmap() - Logical*1 array containing decoded bitmap, -! if ibmap=0 or ibap=254. Otherwise nullified. -! This element is actually a pointer to an array -! that holds the data. -! gfld%fld() = Array of gfld%ndpts unpacked data points. -! This element is actually a pointer to an array -! that holds the data. -! -! REMARKS: -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - use grib_mod - - type(gribfield) :: gfld - - if (associated(gfld%idsect)) then - deallocate(gfld%idsect) - !deallocate(gfld%idsect,stat=is) - !print *,'gfld%idsect: ',is - endif - nullify(gfld%idsect) - - if (associated(gfld%local)) then - deallocate(gfld%local) - !deallocate(gfld%local,stat=is) - !print *,'gfld%local: ',is - endif - nullify(gfld%local) - - if (associated(gfld%list_opt)) then - deallocate(gfld%list_opt) - !deallocate(gfld%list_opt,stat=is) - !print *,'gfld%list_opt: ',is - endif - nullify(gfld%list_opt) - - if (associated(gfld%igdtmpl)) then - deallocate(gfld%igdtmpl) - !deallocate(gfld%igdtmpl,stat=is) - !print *,'gfld%igdtmpl: ',is - endif - nullify(gfld%igdtmpl) - - if (associated(gfld%ipdtmpl)) then - deallocate(gfld%ipdtmpl) - !deallocate(gfld%ipdtmpl,stat=is) - !print *,'gfld%ipdtmpl: ',is - endif - nullify(gfld%ipdtmpl) - - if (associated(gfld%coord_list)) then - deallocate(gfld%coord_list) - !deallocate(gfld%coord_list,stat=is) - !print *,'gfld%coord_list: ',is - endif - nullify(gfld%coord_list) - - if (associated(gfld%idrtmpl)) then - deallocate(gfld%idrtmpl) - !deallocate(gfld%idrtmpl,stat=is) - !print *,'gfld%idrtmpl: ',is - endif - nullify(gfld%idrtmpl) - - if (associated(gfld%bmap)) then - deallocate(gfld%bmap) - !deallocate(gfld%bmap,stat=is) - !print *,'gfld%bmap: ',is - endif - nullify(gfld%bmap) - - if (associated(gfld%fld)) then - deallocate(gfld%fld) - !deallocate(gfld%fld,stat=is) - !print *,'gfld%fld: ',is - endif - nullify(gfld%fld) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_getfld.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_getfld.f deleted file mode 100755 index 25b9c38c7e..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_getfld.f +++ /dev/null @@ -1,602 +0,0 @@ - subroutine gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_getfld -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine returns the Grid Definition, Product Definition, -! Bit-map ( if applicable ), and the unpacked data for a given data -! field. All of the information returned is stored in a derived -! type variable, gfld. Gfld is of type gribfield, which is defined -! in module grib_mod, so users of this routine will need to include -! the line "USE GRIB_MOD" in their calling routine. Each component of the -! gribfield type is described in the OUTPUT ARGUMENT LIST section below. -! -! Since there can be multiple data fields packed into a GRIB2 -! message, the calling routine indicates which field is being requested -! with the ifldnum argument. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to pass back derived type gribfield -! variable through argument list, instead of -! having many different arguments. -! 2004-05-20 Gilbert - Added check to see if previous a bit-map is specified, -! but none was found. -! -! USAGE: CALL gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! ifldnum - Specifies which field in the GRIB2 message to return. -! unpack - Logical value indicating whether to unpack bitmap/data -! .true. = unpack bitmap and data values -! .false. = do not unpack bitmap and data values -! expand - Boolean value indicating whether the data points should be -! expanded to the correspond grid, if a bit-map is present. -! 1 = if possible, expand data field to grid, inserting zero -! values at gridpoints that are bitmapped out. -! (SEE REMARKS2) -! 0 = do not expand data field, leaving it an array of -! consecutive data points for each "1" in the bitmap. -! This argument is ignored if unpack == 0 OR if the -! returned field does not contain a bit-map. -! -! OUTPUT ARGUMENT LIST: -! gfld - derived type gribfield ( defined in module grib_mod ) -! ( NOTE: See Remarks Section ) -! gfld%version = GRIB edition number ( currently 2 ) -! gfld%discipline = Message Discipline ( see Code Table 0.0 ) -! gfld%idsect() = Contains the entries in the Identification -! Section ( Section 1 ) -! This element is actually a pointer to an array -! that holds the data. -! gfld%idsect(1) = Identification of originating Centre -! ( see Common Code Table C-1 ) -! 7 - US National Weather Service -! gfld%idsect(2) = Identification of originating Sub-centre -! gfld%idsect(3) = GRIB Master Tables Version Number -! ( see Code Table 1.0 ) -! 0 - Experimental -! 1 - Initial operational version number -! gfld%idsect(4) = GRIB Local Tables Version Number -! ( see Code Table 1.1 ) -! 0 - Local tables not used -! 1-254 - Number of local tables version used -! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -! 0 - Analysis -! 1 - Start of forecast -! 2 - Verifying time of forecast -! 3 - Observation time -! gfld%idsect(6) = Year ( 4 digits ) -! gfld%idsect(7) = Month -! gfld%idsect(8) = Day -! gfld%idsect(9) = Hour -! gfld%idsect(10) = Minute -! gfld%idsect(11) = Second -! gfld%idsect(12) = Production status of processed data -! ( see Code Table 1.3 ) -! 0 - Operational products -! 1 - Operational test products -! 2 - Research products -! 3 - Re-analysis products -! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -! 0 - Analysis products -! 1 - Forecast products -! 2 - Analysis and forecast products -! 3 - Control forecast products -! 4 - Perturbed forecast products -! 5 - Control and perturbed forecast products -! 6 - Processed satellite observations -! 7 - Processed radar observations -! gfld%idsectlen = Number of elements in gfld%idsect(). -! gfld%local() = Pointer to character array containing contents -! of Local Section 2, if included -! gfld%locallen = length of array gfld%local() -! gfld%ifldnum = field number within GRIB message -! gfld%griddef = Source of grid definition (see Code Table 3.0) -! 0 - Specified in Code table 3.1 -! 1 - Predetermined grid Defined by originating centre -! gfld%ngrdpts = Number of grid points in the defined grid. -! gfld%numoct_opt = Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! gfld%interp_opt = Interpretation of list for optional points -! definition. (Code Table 3.11) -! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -! gfld%igdtmpl() = Contains the data values for the specified Grid -! Definition Template ( NN=gfld%igdtnum ). Each -! element of this integer array contains an entry (in -! the order specified) of Grid Defintion Template 3.NN -! This element is actually a pointer to an array -! that holds the data. -! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -! entries in Grid Defintion Template 3.NN -! ( NN=gfld%igdtnum ). -! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -! contains the number of grid points contained in -! each row ( or column ). (part of Section 3) -! This element is actually a pointer to an array -! that holds the data. This pointer is nullified -! if gfld%numoct_opt=0. -! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. This value -! is set to zero, if gfld%numoct_opt=0. -! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -! gfld%ipdtmpl() = Contains the data values for the specified Product -! Definition Template ( N=gfdl%ipdtnum ). Each element -! of this integer array contains an entry (in the -! order specified) of Product Defintion Template 4.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -! entries in Product Defintion Template 4.N -! ( N=gfdl%ipdtnum ). -! gfld%coord_list() = Real array containing floating point values -! intended to document the vertical discretisation -! associated to model data on hybrid coordinate -! vertical levels. (part of Section 4) -! This element is actually a pointer to an array -! that holds the data. -! gfld%num_coord = number of values in array gfld%coord_list(). -! gfld%ndpts = Number of data points unpacked and returned. -! gfld%idrtnum = Data Representation Template Number -! ( see Code Table 5.0) -! gfld%idrtmpl() = Contains the data values for the specified Data -! Representation Template ( N=gfld%idrtnum ). Each -! element of this integer array contains an entry -! (in the order specified) of Product Defintion -! Template 5.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -! of entries in Data Representation Template 5.N -! ( N=gfld%idrtnum ). -! gfld%unpacked = logical value indicating whether the bitmap and -! data values were unpacked. If false, -! gfld%bmap and gfld%fld pointers are nullified. -! gfld%expanded = Logical value indicating whether the data field -! was expanded to the grid in the case where a -! bit-map is present. If true, the data points in -! gfld%fld match the grid points and zeros were -! inserted at grid points where data was bit-mapped -! out. If false, the data values in gfld%fld were -! not expanded to the grid and are just a consecutive -! array of data points corresponding to each value of -! "1" in gfld%bmap. -! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! gfld%bmap() = Logical*1 array containing decoded bitmap, -! if ibmap=0 or ibap=254. Otherwise nullified. -! This element is actually a pointer to an array -! that holds the data. -! gfld%fld() = Array of gfld%ndpts unpacked data points. -! This element is actually a pointer to an array -! that holds the data. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = The data field request number was not positive. -! 4 = End string "7777" found, but not where expected. -! 6 = GRIB message did not contain the requested number of -! data fields. -! 7 = End string "7777" not found at end of message. -! 8 = Unrecognized Section encountered. -! 9 = Data Representation Template 5.NN not yet implemented. -! 15 = Error unpacking Section 1. -! 16 = Error unpacking Section 2. -! 10 = Error unpacking Section 3. -! 11 = Error unpacking Section 4. -! 12 = Error unpacking Section 5. -! 13 = Error unpacking Section 6. -! 14 = Error unpacking Section 7. -! 17 = Previous bitmap specified, but none exists. -! -! REMARKS: Note that derived type gribfield contains pointers to many -! arrays of data. The memory for these arrays is allocated -! when the values in the arrays are set, to help minimize -! problems with array overloading. Because of this users -! are encouraged to free up this memory, when it is no longer -! needed, by an explicit call to subroutine gf_free. -! ( i.e. CALL GF_FREE(GFLD) ) -! -! Subroutine gb_info can be used to first determine -! how many data fields exist in a given GRIB message. -! -! REMARKS2: It may not always be possible to expand a bit-mapped data field. -! If a pre-defined bit-map is used and not included in the GRIB2 -! message itself, this routine would not have the necessary -! information to expand the data. In this case, gfld%expanded would -! would be set to 0 (false), regardless of the value of input -! argument expand. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - use grib_mod - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ifldnum - logical,intent(in) :: unpack,expand - type(gribfield),intent(out) :: gfld - integer,intent(out) :: ierr -! integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*) -! integer,intent(out) :: ipdsnum,ipdstmpl(*) -! integer,intent(out) :: idrsnum,idrstmpl(*) -! integer,intent(out) :: ndpts,ibmap,idefnum,numcoord -! logical*1,intent(out) :: bmap(*) -! real,intent(out) :: fld(*),coordlist(*) - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4) :: ctemp - real,pointer,dimension(:) :: newfld - integer:: listsec0(2),igds(5) - integer iofst,ibeg,istart - integer(4) :: ieee - logical*1,pointer,dimension(:) :: bmpsave - logical have3,have4,have5,have6,have7 - - interface - subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: ids - integer,intent(out) :: ierr,idslen - end subroutine gf_unpack1 - subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: lencsec2 - integer,intent(out) :: ierr - character(len=1),pointer,dimension(:) :: csec2 - end subroutine gf_unpack2 - subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, - & mapgridlen,ideflist,idefnum,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: igdstmpl,ideflist - integer,intent(out) :: igds(5) - integer,intent(out) :: ierr,idefnum - end subroutine gf_unpack3 - subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl, - & mappdslen,coordlist,numcoord,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - real,pointer,dimension(:) :: coordlist - integer,pointer,dimension(:) :: ipdstmpl - integer,intent(out) :: ipdsnum - integer,intent(out) :: ierr,numcoord - end subroutine gf_unpack4 - subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum, - & idrstmpl,mapdrslen,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: ndpts,idrsnum - integer,pointer,dimension(:) :: idrstmpl - integer,intent(out) :: ierr - end subroutine gf_unpack5 - subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ngpts - integer,intent(inout) :: iofst - integer,intent(out) :: ibmap - integer,intent(out) :: ierr - logical*1,pointer,dimension(:) :: bmap - end subroutine gf_unpack6 - subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl, - & idrsnum,idrstmpl,ndpts,fld,ierr) - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ndpts,idrsnum,igdsnum - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: idrstmpl,igdstmpl - integer,intent(out) :: ierr - real,pointer,dimension(:) :: fld - end subroutine gf_unpack7 - end interface - - have3=.false. - have4=.false. - have5=.false. - have6=.false. - have7=.false. - ierr=0 - numfld=0 - gfld%locallen=0 - nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl) - nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld) -! -! Check for valid request number -! - if (ifldnum.le.0) then - print *,'gf_getfld: Request for field number must be positive.' - ierr=3 - return - endif -! -! Check for beginning of GRIB message in the first 100 bytes -! - istart=0 - do j=1,100 - ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3) - if (ctemp.eq.grib ) then - istart=j - exit - endif - enddo - if (istart.eq.0) then - print *,'gf_getfld: Beginning characters GRIB not found.' - ierr=1 - return - endif -! -! Unpack Section 0 - Indicator Section -! - iofst=8*(istart+5) - call gbyte(cgrib,listsec0(1),iofst,8) ! Discipline - iofst=iofst+8 - call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number - iofst=iofst+8 - iofst=iofst+32 - call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message - iofst=iofst+32 - lensec0=16 - ipos=istart+lensec0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'gf_getfld: can only decode GRIB edition 2.' - ierr=2 - return - endif -! -! Loop through the remaining sections keeping track of the -! length of each. Also keep the latest Grid Definition Section info. -! Unpack the requested field number. -! - do - ! Check to see if we are at end of GRIB message - ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3) - if (ctemp.eq.c7777 ) then - ipos=ipos+4 - ! If end of GRIB message not where expected, issue error - if (ipos.ne.(istart+lengrib)) then - print *,'gf_getfld: "7777" found, but not where expected.' - ierr=4 - return - endif - exit - endif - ! Get length of Section and Section number - iofst=(ipos-1)*8 - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section number - iofst=iofst+8 - !print *,' lensec= ',lensec,' secnum= ',isecnum - ! - ! Check to see if section number is valid - ! - if ( (isecnum.lt.1).OR.(isecnum.gt.7) ) then - print *,'gf_getfld: Unrecognized Section Encountered=',isecnum - ierr=8 - return - endif - ! - ! If found Section 1, decode elements in Identification Section - ! - if (isecnum.eq.1) then - iofst=iofst-40 ! reset offset to beginning of section - call gf_unpack1(cgrib,lcgrib,iofst,gfld%idsect, - & gfld%idsectlen,jerr) - if (jerr.ne.0) then - ierr=15 - return - endif - endif - ! - ! If found Section 2, Grab local section - ! Save in case this is the latest one before the requested field. - ! - if (isecnum.eq.2) then - iofst=iofst-40 ! reset offset to beginning of section - if (associated(gfld%local)) deallocate(gfld%local) - call gf_unpack2(cgrib,lcgrib,iofst,gfld%locallen, - & gfld%local,jerr) - if (jerr.ne.0) then - ierr=16 - return - endif - endif - ! - ! If found Section 3, unpack the GDS info using the - ! appropriate template. Save in case this is the latest - ! grid before the requested field. - ! - if (isecnum.eq.3) then - iofst=iofst-40 ! reset offset to beginning of section - if (associated(gfld%igdtmpl)) deallocate(gfld%igdtmpl) - if (associated(gfld%list_opt)) deallocate(gfld%list_opt) - call gf_unpack3(cgrib,lcgrib,iofst,igds,gfld%igdtmpl, - & gfld%igdtlen,gfld%list_opt,gfld%num_opt,jerr) - if (jerr.eq.0) then - have3=.true. - gfld%griddef=igds(1) - gfld%ngrdpts=igds(2) - gfld%numoct_opt=igds(3) - gfld%interp_opt=igds(4) - gfld%igdtnum=igds(5) - else - ierr=10 - return - endif - endif - ! - ! If found Section 4, check to see if this field is the - ! one requested. - ! - if (isecnum.eq.4) then - numfld=numfld+1 - if (numfld.eq.ifldnum) then - gfld%discipline=listsec0(1) - gfld%version=listsec0(2) - gfld%ifldnum=ifldnum - gfld%unpacked=unpack - gfld%expanded=.false. - iofst=iofst-40 ! reset offset to beginning of section - call gf_unpack4(cgrib,lcgrib,iofst,gfld%ipdtnum, - & gfld%ipdtmpl,gfld%ipdtlen,gfld%coord_list, - & gfld%num_coord,jerr) - if (jerr.eq.0) then - have4=.true. - else - ierr=11 - return - endif - endif - endif - ! - ! If found Section 5, check to see if this field is the - ! one requested. - ! - if ((isecnum.eq.5).and.(numfld.eq.ifldnum)) then - iofst=iofst-40 ! reset offset to beginning of section - call gf_unpack5(cgrib,lcgrib,iofst,gfld%ndpts,gfld%idrtnum, - & gfld%idrtmpl,gfld%idrtlen,jerr) - if (jerr.eq.0) then - have5=.true. - else - ierr=12 - return - endif - endif - ! - ! If found Section 6, Unpack bitmap. - ! Save in case this is the latest - ! bitmap before the requested field. - ! - if (isecnum.eq.6) then - if (unpack) then ! unpack bitmap - iofst=iofst-40 ! reset offset to beginning of section - bmpsave=>gfld%bmap ! save pointer to previous bitmap - call gf_unpack6(cgrib,lcgrib,iofst,gfld%ngrdpts,gfld%ibmap, - & gfld%bmap,jerr) - if (jerr.eq.0) then - have6=.true. - if (gfld%ibmap .eq. 254) then ! use previously specified bitmap - if ( associated(bmpsave) ) then - gfld%bmap=>bmpsave - else - print *,'gf_getfld: Previous bit-map specified,', - & ' but none exists,' - ierr=17 - return - endif - else ! get rid of it - if ( associated(bmpsave) ) deallocate(bmpsave) - endif - else - ierr=13 - return - endif - else ! do not unpack bitmap - call gbyte(cgrib,gfld%ibmap,iofst,8) ! Get BitMap Indicator - have6=.true. - endif - endif - ! - ! If found Section 7, check to see if this field is the - ! one requested. - ! - if ((isecnum.eq.7).and.(numfld.eq.ifldnum).and.unpack) then - iofst=iofst-40 ! reset offset to beginning of section - call gf_unpack7(cgrib,lcgrib,iofst,gfld%igdtnum, - & gfld%igdtmpl,gfld%idrtnum, - & gfld%idrtmpl,gfld%ndpts, - & gfld%fld,jerr) - if (jerr.eq.0) then - have7=.true. - ! If bitmap is used with this field, expand data field - ! to grid, if possible. - if ( gfld%ibmap .ne. 255 .AND. associated(gfld%bmap) ) then - if ( expand ) then - allocate(newfld(gfld%ngrdpts)) - !newfld(1:gfld%ngrdpts)=0.0 - !newfld=unpack(gfld%fld,gfld%bmap,newfld) - n=1 - do j=1,gfld%ngrdpts - if ( gfld%bmap(j) ) then - newfld(j)=gfld%fld(n) - n=n+1 - else - newfld(j)=0.0 - endif - enddo - deallocate(gfld%fld); - gfld%fld=>newfld; - gfld%expanded=.true. - else - gfld%expanded=.false. - endif - else - gfld%expanded=.true. - endif - else - print *,'gf_getfld: return from gf_unpack7 = ',jerr - ierr=14 - return - endif - endif - ! - ! Check to see if we read pass the end of the GRIB - ! message and missed the terminator string '7777'. - ! - ipos=ipos+lensec ! Update beginning of section pointer - if (ipos.gt.(istart+lengrib)) then - print *,'gf_getfld: "7777" not found at end of GRIB message.' - ierr=7 - return - endif - ! - ! If unpacking requested, return when all sections have been - ! processed - ! - if (unpack.and.have3.and.have4.and.have5.and.have6.and.have7) - & return - ! - ! If unpacking is not requested, return when sections - ! 3 through 6 have been processed - ! - if ((.NOT.unpack).and.have3.and.have4.and.have5.and.have6) - & return - - enddo - -! -! If exited from above loop, the end of the GRIB message was reached -! before the requested field was found. -! - print *,'gf_getfld: GRIB message contained ',numlocal, - & ' different fields.' - print *,'gf_getfld: The request was for the ',ifldnum, - & ' field.' - ierr=6 - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack1.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack1.f deleted file mode 100755 index 9b3cb1bfab..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack1.f +++ /dev/null @@ -1,93 +0,0 @@ - subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack1 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 1 (Identification Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to dynamically allocate arrays -! and to pass pointers to those arrays through -! the argument list. -! -! USAGE: CALL gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array containing Section 1 of the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 1. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 1, returned. -! ids - Pointer to integer array containing information read from -! Section 1, the Identification section. -! ids(1) = Identification of originating Centre -! ( see Common Code Table C-1 ) -! ids(2) = Identification of originating Sub-centre -! ids(3) = GRIB Master Tables Version Number -! ( see Code Table 1.0 ) -! ids(4) = GRIB Local Tables Version Number -! ( see Code Table 1.1 ) -! ids(5) = Significance of Reference Time (Code Table 1.2) -! ids(6) = Year ( 4 digits ) -! ids(7) = Month -! ids(8) = Day -! ids(9) = Hour -! ids(10) = Minute -! ids(11) = Second -! ids(12) = Production status of processed data -! ( see Code Table 1.3 ) -! ids(13) = Type of processed data ( see Code Table 1.4 ) -! idslen - Number of elements in ids(). -! ierr - Error return code. -! 0 = no error -! 6 = memory allocation error -! -! REMARKS: -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: ids - integer,intent(out) :: ierr,idslen - - integer,dimension(:) :: mapid(13) - - data mapid /2,2,1,1,1,2,1,1,1,1,1,1,1/ - - ierr=0 - idslen=13 - nullify(ids) - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - ! - ! Unpack each value into array ids from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapid. - ! - istat=0 - allocate(ids(idslen),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(ids) - return - endif - - do i=1,idslen - nbits=mapid(i)*8 - call gbyte(cgrib,ids(i),iofst,nbits) - iofst=iofst+nbits - enddo - - return ! End of Section 1 processing - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack2.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack2.f deleted file mode 100755 index 6a18b5f7c7..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack2.f +++ /dev/null @@ -1,72 +0,0 @@ - subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack2 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-04-09 -! -! ABSTRACT: This subroutine unpacks Section 2 (Local Use Section) -! as defined in GRIB Edition 2. -! -! PROGRAM HISTORY LOG: -! 2002-04-09 Gilbert -! -! USAGE: CALL gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array containing Section 2 of the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 2. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 2, returned. -! lencsec2 - Length (in octets) of Local Use data -! csec2() - Pointer to a character*1 array containing local use data -! ierr - Error return code. -! 0 = no error -! 2 = Array passed is not section 2 -! 6 = memory allocation error -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: lencsec2 - integer,intent(out) :: ierr - character(len=1),pointer,dimension(:) :: csec2 - - ierr=0 - lencsec2=0 - nullify(csec2) - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - lencsec2=lensec-5 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section Number - iofst=iofst+8 - ipos=(iofst/8)+1 - - if ( isecnum.ne.2 ) then - ierr=6 - print *,'gf_unpack2: Not Section 2 data. ' - return - endif - - allocate(csec2(lencsec2),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(csec2) - return - endif - - csec2(1:lencsec2)=cgrib(ipos:ipos+lencsec2-1) - iofst=iofst+(lencsec2*8) - - return ! End of Section 2 processing - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack3.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack3.f deleted file mode 100755 index 3ed3268e24..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack3.f +++ /dev/null @@ -1,189 +0,0 @@ - subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, - & mapgridlen,ideflist,idefnum,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack3 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to dynamically allocate arrays -! and to pass pointers to those arrays through -! the argument list. -! -! USAGE: CALL gf_unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl, -! & mapgridlen,ideflist,idefnum,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 3. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 3, returned. -! igds - Contains information read from the appropriate GRIB Grid -! Definition Section 3 for the field being returned. -! Must be dimensioned >= 5. -! igds(1)=Source of grid definition (see Code Table 3.0) -! igds(2)=Number of grid points in the defined grid. -! igds(3)=Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! igds(4)=Interpretation of list for optional points -! definition. (Code Table 3.11) -! igds(5)=Grid Definition Template Number (Code Table 3.1) -! igdstmpl - Pointer to integer array containing the data values for -! the specified Grid Definition -! Template ( NN=igds(5) ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Defintion Template 3.NN -! mapgridlen- Number of elements in igdstmpl(). i.e. number of entries -! in Grid Defintion Template 3.NN ( NN=igds(5) ). -! ideflist - (Used if igds(3) .ne. 0) Pointer to integer array containing -! the number of grid points contained in each row ( or column ). -! (part of Section 3) -! idefnum - (Used if igds(3) .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. -! ierr - Error return code. -! 0 = no error -! 5 = "GRIB" message contains an undefined Grid Definition -! Template. -! 6 = memory allocation error -! -! REMARKS: Uses Fortran 90 module gridtemplates and module re_alloc. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use gridtemplates - use re_alloc ! needed for subroutine realloc - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: igdstmpl,ideflist - integer,intent(out) :: igds(5) - integer,intent(out) :: ierr,idefnum - - integer,allocatable :: mapgrid(:) - integer :: mapgridlen,ibyttem - logical needext - - ierr=0 - nullify(igdstmpl,ideflist) - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - - call gbyte(cgrib,igds(1),iofst,8) ! Get source of Grid def. - iofst=iofst+8 - call gbyte(cgrib,igds(2),iofst,32) ! Get number of grid pts. - iofst=iofst+32 - call gbyte(cgrib,igds(3),iofst,8) ! Get num octets for opt. list - iofst=iofst+8 - call gbyte(cgrib,igds(4),iofst,8) ! Get interpret. for opt. list - iofst=iofst+8 - call gbyte(cgrib,igds(5),iofst,16) ! Get Grid Def Template num. - iofst=iofst+16 -! if (igds(1).eq.0) then - if (igds(1).eq.0.OR.igds(1).eq.255) then ! FOR ECMWF TEST ONLY - allocate(mapgrid(lensec)) - ! Get Grid Definition Template - call getgridtemplate(igds(5),mapgridlen,mapgrid,needext, - & iret) - if (iret.ne.0) then - ierr=5 - if( allocated(mapgrid) ) deallocate(mapgrid) - return - endif - else -! igdstmpl=-1 - mapgridlen=0 - needext=.false. - endif - ! - ! Unpack each value into array igdstmpl from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapgrid. - ! - istat=0 - if (mapgridlen.gt.0) allocate(igdstmpl(mapgridlen),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(igdstmpl) - if( allocated(mapgrid) ) deallocate(mapgrid) - return - endif - ibyttem=0 - do i=1,mapgridlen - nbits=iabs(mapgrid(i))*8 - if ( mapgrid(i).ge.0 ) then - call gbyte(cgrib,igdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) - endif - iofst=iofst+nbits - ibyttem=ibyttem+iabs(mapgrid(i)) - enddo - ! - ! Check to see if the Grid Definition Template needs to be - ! extended. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid) - ! Unpack the rest of the Grid Definition Template - call realloc(igdstmpl,mapgridlen,newmapgridlen,istat) - do i=mapgridlen+1,newmapgridlen - nbits=iabs(mapgrid(i))*8 - if ( mapgrid(i).ge.0 ) then - call gbyte(cgrib,igdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) - endif - iofst=iofst+nbits - ibyttem=ibyttem+iabs(mapgrid(i)) - enddo - mapgridlen=newmapgridlen - endif - if( allocated(mapgrid) ) deallocate(mapgrid) - ! - ! Unpack optional list of numbers defining number of points - ! in each row or column, if included. This is used for non regular - ! grids. - ! - if ( igds(3).ne.0 ) then - nbits=igds(3)*8 - idefnum=(lensec-14-ibyttem)/igds(3) - istat=0 - if (idefnum.gt.0) allocate(ideflist(idefnum),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(ideflist) - return - endif - call gbytes(cgrib,ideflist,iofst,nbits,0,idefnum) - iofst=iofst+(nbits*idefnum) - else - idefnum=0 - nullify(ideflist) - endif - - return ! End of Section 3 processing - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack4.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack4.f deleted file mode 100755 index 9b29dce2ee..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack4.f +++ /dev/null @@ -1,159 +0,0 @@ - subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl, - & mappdslen,coordlist,numcoord,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack4 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 4 (Product Definition Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to dynamically allocate arrays -! and to pass pointers to those arrays through -! the argument list. -! -! USAGE: CALL gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen, -! & coordlist,numcoord,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 4. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset of the end of Section 4, returned. -! ipdsnum - Product Definition Template Number ( see Code Table 4.0) -! ipdstmpl - Pointer to integer array containing the data values for -! the specified Product Definition -! Template ( N=ipdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 4.N -! mappdslen- Number of elements in ipdstmpl(). i.e. number of entries -! in Product Defintion Template 4.N ( N=ipdsnum ). -! coordlist- Pointer to real array containing floating point values -! intended to document -! the vertical discretisation associated to model data -! on hybrid coordinate vertical levels. (part of Section 4) -! numcoord - number of values in array coordlist. -! ierr - Error return code. -! 0 = no error -! 5 = "GRIB" message contains an undefined Product Definition -! Template. -! 6 = memory allocation error -! -! REMARKS: Uses Fortran 90 module pdstemplates and module re_alloc. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use pdstemplates - use re_alloc ! needed for subroutine realloc - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - real,pointer,dimension(:) :: coordlist - integer,pointer,dimension(:) :: ipdstmpl - integer,intent(out) :: ipdsnum - integer,intent(out) :: ierr,numcoord - - real(4),allocatable :: coordieee(:) - integer,allocatable :: mappds(:) - integer :: mappdslen - logical needext - - ierr=0 - nullify(ipdstmpl,coordlist) - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - allocate(mappds(lensec)) - - call gbyte(cgrib,numcoord,iofst,16) ! Get num of coordinate values - iofst=iofst+16 - call gbyte(cgrib,ipdsnum,iofst,16) ! Get Prod. Def Template num. - iofst=iofst+16 - ! Get Product Definition Template - call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret) - if (iret.ne.0) then - ierr=5 - if( allocated(mappds) ) deallocate(mappds) - return - endif - ! - ! Unpack each value into array ipdstmpl from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mappds. - ! - istat=0 - if (mappdslen.gt.0) allocate(ipdstmpl(mappdslen),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(ipdstmpl) - if( allocated(mappds) ) deallocate(mappds) - return - endif - do i=1,mappdslen - nbits=iabs(mappds(i))*8 - if ( mappds(i).ge.0 ) then - call gbyte(cgrib,ipdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i) - endif - iofst=iofst+nbits - enddo - ! - ! Check to see if the Product Definition Template needs to be - ! extended. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extpdstemplate(ipdsnum,ipdstmpl,newmappdslen,mappds) - call realloc(ipdstmpl,mappdslen,newmappdslen,istat) - ! Unpack the rest of the Product Definition Template - do i=mappdslen+1,newmappdslen - nbits=iabs(mappds(i))*8 - if ( mappds(i).ge.0 ) then - call gbyte(cgrib,ipdstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i) - endif - iofst=iofst+nbits - enddo - mappdslen=newmappdslen - endif - if( allocated(mappds) ) deallocate(mappds) - ! - ! Get Optional list of vertical coordinate values - ! after the Product Definition Template, if necessary. - ! - nullify(coordlist) - if ( numcoord .ne. 0 ) then - allocate (coordieee(numcoord),stat=istat1) - allocate(coordlist(numcoord),stat=istat) - if ((istat1+istat).ne.0) then - ierr=6 - nullify(coordlist) - if( allocated(coordieee) ) deallocate(coordieee) - return - endif - call gbytes(cgrib,coordieee,iofst,32,0,numcoord) - call rdieee(coordieee,coordlist,numcoord) - deallocate (coordieee) - iofst=iofst+(32*numcoord) - endif - - return ! End of Section 4 processing - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack5.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack5.f deleted file mode 100755 index 9a6ee1303e..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack5.f +++ /dev/null @@ -1,134 +0,0 @@ - subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl, - & mapdrslen,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack5 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 5 (Data Representation Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to dynamically allocate arrays -! and to pass pointers to those arrays through -! the argument list. -! -! USAGE: CALL gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl, -! mapdrslen,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 5. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 5, returned. -! ndpts - Number of data points unpacked and returned. -! idrsnum - Data Representation Template Number ( see Code Table 5.0) -! idrstmpl - Pointer to an integer array containing the data values for -! the specified Data Representation -! Template ( N=idrsnum ). Each element of this integer -! array contains an entry (in the order specified) of Data -! Representation Template 5.N -! mapdrslen- Number of elements in idrstmpl(). i.e. number of entries -! in Data Representation Template 5.N ( N=idrsnum ). -! ierr - Error return code. -! 0 = no error -! 6 = memory allocation error -! 7 = "GRIB" message contains an undefined Data -! Representation Template. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - use drstemplates - use re_alloc ! needed for subroutine realloc - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(inout) :: iofst - integer,intent(out) :: ndpts,idrsnum - integer,pointer,dimension(:) :: idrstmpl - integer,intent(out) :: ierr - - integer,allocatable :: mapdrs(:) - integer :: mapdrslen - logical needext - - ierr=0 - nullify(idrstmpl) - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - allocate(mapdrs(lensec)) - - call gbyte(cgrib,ndpts,iofst,32) ! Get num of data points - iofst=iofst+32 - call gbyte(cgrib,idrsnum,iofst,16) ! Get Data Rep Template Num. - iofst=iofst+16 - ! Gen Data Representation Template - call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret) - if (iret.ne.0) then - ierr=7 - if( allocated(mapdrs) ) deallocate(mapdrs) - return - endif - ! - ! Unpack each value into array ipdstmpl from the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mappds. - ! - istat=0 - if (mapdrslen.gt.0) allocate(idrstmpl(mapdrslen),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(idrstmpl) - if( allocated(mapdrs) ) deallocate(mapdrs) - return - endif - do i=1,mapdrslen - nbits=iabs(mapdrs(i))*8 - if ( mapdrs(i).ge.0 ) then - call gbyte(cgrib,idrstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) idrstmpl(i)=-idrstmpl(i) - endif - iofst=iofst+nbits - enddo - ! - ! Check to see if the Data Representation Template needs to be - ! extended. - ! The number of values in a specific template may vary - ! depending on data specified in the "static" part of the - ! template. - ! - if ( needext ) then - call extdrstemplate(idrsnum,idrstmpl,newmapdrslen,mapdrs) - call realloc(idrstmpl,mapdrslen,newmapdrslen,istat) - ! Unpack the rest of the Data Representation Template - do i=mapdrslen+1,newmapdrslen - nbits=iabs(mapdrs(i))*8 - if ( mapdrs(i).ge.0 ) then - call gbyte(cgrib,idrstmpl(i),iofst,nbits) - else - call gbyte(cgrib,isign,iofst,1) - call gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1) - if (isign.eq.1) idrstmpl(i)=-idrstmpl(i) - endif - iofst=iofst+nbits - enddo - mapdrslen=newmapdrslen - endif - if( allocated(mapdrs) ) deallocate(mapdrs) - - return ! End of Section 5 processing - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack6.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack6.f deleted file mode 100755 index f963a50949..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack6.f +++ /dev/null @@ -1,88 +0,0 @@ - subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack6 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine unpacks Section 6 (Bit-Map Section) -! starting at octet 6 of that Section. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to dynamically allocate arrays -! and to pass pointers to those arrays through -! the argument list. -! -! USAGE: CALL gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 6. -! ngpts - Number of grid points specified in the bit-map -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 6, returned. -! ibmap - Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! bmap() - Pointer to a logical*1 array containing decoded bitmap. -! ( if ibmap=0 ) -! ierr - Error return code. -! 0 = no error -! 4 = Unrecognized pre-defined bit-map. -! 6 = memory allocation error -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ngpts - integer,intent(inout) :: iofst - integer,intent(out) :: ibmap - integer,intent(out) :: ierr - logical*1,pointer,dimension(:) :: bmap - - integer :: intbmap(ngpts) - - ierr=0 - nullify(bmap) - - iofst=iofst+32 ! skip Length of Section - iofst=iofst+8 ! skip section number - - call gbyte(cgrib,ibmap,iofst,8) ! Get bit-map indicator - iofst=iofst+8 - - if (ibmap.eq.0) then ! Unpack bitmap - istat=0 - if (ngpts.gt.0) allocate(bmap(ngpts),stat=istat) - if (istat.ne.0) then - ierr=6 - nullify(bmap) - return - endif - call gbytes(cgrib,intbmap,iofst,1,0,ngpts) - iofst=iofst+ngpts - do j=1,ngpts - bmap(j)=.true. - if (intbmap(j).eq.0) bmap(j)=.false. - enddo -! elseif (ibmap.eq.254) then ! Use previous bitmap -! return -! elseif (ibmap.eq.255) then ! No bitmap in message -! bmap(1:ngpts)=.true. -! else -! print *,'gf_unpack6: Predefined bitmap ',ibmap,' not recognized.' -! ierr=4 - endif - - return ! End of Section 6 processing - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack7.F b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack7.F deleted file mode 100755 index 2c6e8352b0..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gf_unpack7.F +++ /dev/null @@ -1,124 +0,0 @@ - subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl, - & idrsnum,idrstmpl,ndpts,fld,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_unpack7 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-24 -! -! ABSTRACT: This subroutine unpacks GRIB2 Section 7 (Data Section). -! -! PROGRAM HISTORY LOG: -! 2002-01-24 Gilbert -! 2002-12-17 Gilbert - Added support for new templates using -! PNG and JPEG2000 algorithms/templates. -! 2004-12-29 Gilbert - Added check on comunpack return code. -! -! USAGE: CALL gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl, -! & idrsnum,idrstmpl,ndpts,fld,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! iofst - Bit offset of the beginning of Section 7. -! igdsnum - Grid Definition Template Number ( see Code Table 3.0) -! (Only required to unpack DRT 5.51) -! igdstmpl - Pointer to an integer array containing the data values for -! the specified Grid Definition -! Template ( N=igdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Definition Template 3.N -! (Only required to unpack DRT 5.51) -! idrsnum - Data Representation Template Number ( see Code Table 5.0) -! idrstmpl - Pointer to an integer array containing the data values for -! the specified Data Representation -! Template ( N=idrsnum ). Each element of this integer -! array contains an entry (in the order specified) of Data -! Representation Template 5.N -! ndpts - Number of data points unpacked and returned. -! -! OUTPUT ARGUMENT LIST: -! iofst - Bit offset at the end of Section 7, returned. -! fld() - Pointer to a real array containing the unpacked data field. -! ierr - Error return code. -! 0 = no error -! 4 = Unrecognized Data Representation Template -! 5 = One of GDT 3.50 through 3.53 required to unpack DRT 5.51 -! 6 = memory allocation error -! 7 = corrupt section 7. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib,ndpts,igdsnum,idrsnum - integer,intent(inout) :: iofst - integer,pointer,dimension(:) :: igdstmpl,idrstmpl - integer,intent(out) :: ierr - real,pointer,dimension(:) :: fld - - - ierr=0 - nullify(fld) - - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - iofst=iofst+8 ! skip section number - - ipos=(iofst/8)+1 - istat=0 - allocate(fld(ndpts),stat=istat) - if (istat.ne.0) then - ierr=6 - return - endif - - if (idrsnum.eq.0) then - call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld) - elseif (idrsnum.eq.2.or.idrsnum.eq.3) then - call comunpack(cgrib(ipos),lensec-5,lensec,idrsnum,idrstmpl, - & ndpts,fld,ier) - if ( ier .NE. 0 ) then - ierr=7 - return - endif - elseif (idrsnum.eq.50) then ! Spectral simple - call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts-1, - & fld(2)) - ieee=idrstmpl(5) - call rdieee(ieee,fld(1),1) - elseif (idrsnum.eq.51) then ! Spectral complex - if (igdsnum.ge.50.AND.igdsnum.le.53) then - call specunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts, - & igdstmpl(1),igdstmpl(2),igdstmpl(3),fld) - else - print *,'gf_unpack7: Cannot use GDT 3.',igdsnum, - & ' to unpack Data Section 5.51.' - ierr=5 - nullify(fld) - return - endif -#ifdef USE_JPEG2000 - elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then - call jpcunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld) -#endif /* USE_JPEG2000 */ -#ifdef USE_PNG - elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then - call pngunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld) -#endif /* USE_PNG */ - else - print *,'gf_unpack7: Data Representation Template ',idrsnum, - & ' not yet implemented.' - ierr=4 - nullify(fld) - return - endif - - iofst=iofst+(8*lensec) - - return ! End of Section 7 processing - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/grib2.doc b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/grib2.doc deleted file mode 100755 index 20cedddfe7..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/grib2.doc +++ /dev/null @@ -1,1220 +0,0 @@ - GRIB2 USERS GUIDE (FORTRAN 90) - -Contents: - -- Introduction -- GRIB2 Encoding Routines -- GRIB2 Decoding Routines -- Extracting GRIB2 Fields from a GRIB2 file -- GRIB2 Tables/Templates -- GRIB2 Routine Docblocks - -=============================================================================== - - Introduction - -This document briefly describes the routines available for encoding/decoding -GRIB Edition 2 (GRIB2) messages. A basic familiarity with GRIB is assumed. - -A GRIB Edition 2 message is a machine independent format for storing -one or more gridded data fields. Each GRIB2 message consists of the -following sections: - -SECTION 0 - Indicator Section -SECTION 1 - Identification Section -SECTION 2 - (Local Use Section) - optional } -SECTION 3 - Grid Definition Section } } -SECTION 4 - Product Definition Section } } }(repeated) -SECTION 5 - Data Representation Section } }(repeated) } -SECTION 6 - Bit-map Section }(repeated) } } -SECTION 7 - Data Section } } } -SECTION 8 - End Section } } } - -Sequences of GRIB sections 2 to 7, 3 to 7, or sections 4 to 7 may be repeated -within a single GRIB message. All sections within such repeated sequences -must be present and shall appear in the numerical order noted above. -Unrepeated sections remain in effect until redefined. - -The above overview was taken from WMO's FM 92-XII GRIB description -of the experimental GRIB Edition 2 form. - -=============================================================================== - - GRIB2 Encoding Routines - -Since a GRIB2 message can contain gridded fields for many parameters on -a number of different grids, several routines are used to encode a message. -This should give users more flexibility in how to organize data -within one or more GRIB2 messages. - -To start a new GRIB2 message, call subroutine GRIBCREATE. GRIBCREATE -encodes Sections 0 and 1 at the beginning of the message. This routine -must be used to create each message. - -Subroutine ADDLOCAL can be used to add a Local Use Section ( Section 2 ). -Note that section is optional and need not appear in a GRIB2 message. - -Subroutine ADDGRID is used to encode a grid definition into Section 3. -This grid definition defines the geometry of the the data values in the -fields that follow it. ADDGRID can be called again to change the grid -definition describing subsequent data fields. - -Each data field is added to the GRIB2 message using routine ADDFIELD, -which adds Sections 4, 5, 6, and 7 to the message. - -After all desired data fields have been added to the GRIB2 message, a -call to routine GRIBEND is needed to add the final section 8 to the -message and to update the length of the message. A call to GRIBEND -is required for each GRIB2 message. - -Please see the "GRIB2 Routine Docblocks" section below for subroutine -argument usage for the routines mentioned above. - -=============================================================================== - - GRIB2 Decoding Routines - -Subroutine GB_INFO can be used to find out how many Local Use sections -and data fields are contained in a given GRIB2 message. In addition, -this routine also returns the number of octets of the largest Local Use -section in the message. This value can be used to ensure that the -output array of subroutine GETLOCAL ( described below ) is dimensioned -large enough. - -Subroutine GETLOCAL will return the requested occurrence of Section 2 -from a given GRIB2 message. - -GF_GETFLD can be used to get all information pertaining to the nth -data field in the message. The subroutine returns all the unpacked values -for each Section and Template in a Fortran 90 derived type gribfield, -which is defined in module GRIB_MOD. An option exists that lets the -user decide if the subroutine should unpack the Bit-map ( if -applicable ) and the data values or just return the field description -information. -Note that derived type gribfield contains pointers to dynamically -allocated space that holds the contents of all arrays, and users are encouraged -to free up this memory, when it is no longer needed, by an explicit call -to subroutine GF_FREE. - -Please see the "GRIB2 Routine Docblocks" section below for subroutine -argument usage for the routines mentioned above. - -=============================================================================== - - Extracting GRIB2 Fields from a GRIB2 file - -Subroutine GETGB2 can be used to extract a specified field from a file -containing many GRIB2 messages. GETGB2 searches an index to find the -location of the user specified field. The index can be supplied from a -seperate GRIB2 index file, or it can be generated internally. - -The GRIB2 file ( and the index file, if supplied ) must be opened with -a call to subroutine BAOPEN prior to the call to GETGB2. - -The decoded information for the selected GRIB field is returned in a -derived type variable, gfld. Gfld is of type gribfield, which is defined -in module grib_mod, so users of this routine will need to include -the line "USE GRIB_MOD" in their calling routine. Each component of the -gribfield type is described in the OUTPUT ARGUMENT LIST in the docblock -for subroutine GETGB2 below. - -Note that derived type gribfield contains pointers to many arrays of data. -The memory for these arrays is allocated when the values in the arrays -are set, to help minimize problems with array overloading. Because of this, -users are encouraged to free up this memory, when it is no longer -needed, by an explicit call to subroutine GF_FREE. - -Example usage: - - use grib_mod - type(gribfield) :: gfld - integer,dimension(200) :: jids,jpdt,jgdt - logical :: unpack=.true. - ifile=10 - ! Open GRIB2 file - call baopenr(ifile,"filename",iret) - . - ! Set GRIB2 field identification values to search for - jdisc= - jids(?)= - jpdtn= - jpdt(?)= - jgdtn= - jgdt(?)= - - ! Get field from file - call getgb2(ifile,0,j,jdisc,jids,jpdtn,jpdt,jgdtn,jgdt, - & unpack,j,gfld,iret) - - ! Process field ... - firstval=gfld%fld(1) - lastval=gfld%fld(gfld%ndpts) - fldmax=maxval(gfld%fld) - fldmin=minval(gfld%fld) - - ! Free memory when done with field - call gf_free(gfld) - - stop - end - -Please see the "GRIB2 Routine Docblocks" section below for subroutine -argument usage for the routines mentioned above. - -=============================================================================== - - GRIB2 Tables/Templates - -WMO's GRIB2 specification "FM 92-XII GRIB - General Regularly-distributed -Information in Binary Form" contains descriptions of each template -and code table information. This document can be found at -http://www.wmo.ch/web/www/WMOCodes.html -(PDF and MSWord formats are available) - -MDL has made an HTML version of the document available at -http://www.nws.noaa.gov/tdl/iwt/grib2/frameset_grib2.htm. - -=============================================================================== - - GRIB2 Routine Docblocks - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gribcreate -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-04-28 -! -! ABSTRACT: This subroutine initializes a new GRIB2 message and packs -! GRIB2 sections 0 (Indicator Section) and 1 (Identification Section). -! This routine is used with routines "addlocal", "addgrid", "addfield", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! Also, a call to gribend is required to complete GRIB2 message -! after all fields have been added. -! -! PROGRAM HISTORY LOG: -! 2000-04-28 Gilbert -! -! USAGE: CALL gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! listsec0 - Contains information needed for GRIB Indicator Section 0. -! Must be dimensioned >= 2. -! listsec0(1)=Discipline-GRIB Master Table Number -! (see Code Table 0.0) -! listsec0(2)=GRIB Edition Number (currently 2) -! listsec1 - Contains information needed for GRIB Identification Section 1. -! Must be dimensioned >= 13. -! listsec1(1)=Id of orginating centre (Common Code Table C-1) -! listsec1(2)=Id of orginating sub-centre (local table) -! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0) -! listsec1(4)=GRIB Local Tables Version Number (Code Table 1.1) -! listsec1(5)=Significance of Reference Time (Code Table 1.2) -! listsec1(6)=Reference Time - Year (4 digits) -! listsec1(7)=Reference Time - Month -! listsec1(8)=Reference Time - Day -! listsec1(9)=Reference Time - Hour -! listsec1(10)=Reference Time - Minute -! listsec1(11)=Reference Time - Second -! listsec1(12)=Production status of data (Code Table 1.3) -! listsec1(13)=Type of processed data (Code Table 1.4) -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = Tried to use for version other than GRIB Edition 2 -! -! REMARKS: This routine is intended for use with routines "addlocal", -! "addgrid", "addfield", and "gribend" to create a complete -! GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: addlocal -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-01 -! -! ABSTRACT: This subroutine adds a Local Use Section (Section 2) to -! a GRIB2 message. -! This routine is used with routines "gribcreate", "addgrid", "addfield", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-01 Gilbert -! -! USAGE: CALL addlocal(cgrib,lcgrib,csec2,lcsec2,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! csec2 - Character array containing information to be added to -! Section 2. -! lcsec2 - Number of bytes of character array csec2 to be added to -! Section 2. -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. Cannot add new section. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 1 or 7. -! -! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow -! Section 1 or Section 7 in a GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: addgrid -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-01 -! -! ABSTRACT: This subroutine packs up a Grid Definition Section (Section 3) -! and adds it to a GRIB2 message. -! This routine is used with routines "gribcreate", "addlocal", "addfield", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-01 Gilbert -! -! USAGE: CALL addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen, -! ideflist,idefnum,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! igds - Contains information needed for GRIB Grid Definition Section 3. -! Must be dimensioned >= 5. -! igds(1)=Source of grid definition (see Code Table 3.0) -! igds(2)=Number of grid points in the defined grid. -! igds(3)=Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! igds(4)=Interpretation of list for optional points -! definition. (Code Table 3.11) -! igds(5)=Grid Definition Template Number (Code Table 3.1) -! igdstmpl - Contains the data values for the specified Grid Definition -! Template ( NN=igds(5) ). Each element of this integer -! array contains an entry (in the order specified) of Grid -! Defintion Template 3.NN -! igdstmplen - Max dimension of igdstmpl() -! ideflist - (Used if igds(3) .ne. 0) This array contains the -! number of grid points contained in each row ( or column ) -! idefnum - (Used if igds(3) .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. Cannot add new section. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 1, 2 or 7. -! 5 = Could not find requested Grid Definition Template. -! -! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow -! Section 1 or Section 7 in a GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: addfield -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-02 -! -! ABSTRACT: This subroutine packs up Sections 4 through 7 for a given field -! and adds them to a GRIB2 message. They are Product Definition Section, -! Data Representation Section, Bit-Map Section and Data Section, -! respectively. -! This routine is used with routines "gribcreate", "addlocal", "addgrid", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! Also, subroutine addgrid must be called after gribcreate and -! before this routine to add the appropriate grid description to -! the GRIB2 message. Also, a call to gribend is required to complete -! GRIB2 message after all fields have been added. -! -! PROGRAM HISTORY LOG: -! 2000-05-02 Gilbert -! 2002-12-17 Gilbert - Added support for new templates using -! PNG and JPEG2000 algorithms/templates. -! 2004-06-22 Gilbert - Added check to determine if packing algorithm failed. -! -! USAGE: CALL addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen, -! coordlist,numcoord,idrsnum,idrstmpl, -! idrstmplen,fld,ngrdpts,ibmap,bmap,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! ipdsnum - Product Definition Template Number ( see Code Table 4.0) -! ipdstmpl - Contains the data values for the specified Product Definition -! Template ( N=ipdsnum ). Each element of this integer -! array contains an entry (in the order specified) of Product -! Defintion Template 4.N -! ipdstmplen - Max dimension of ipdstmpl() -! coordlist- Array containg floating point values intended to document -! the vertical discretisation associated to model data -! on hybrid coordinate vertical levels. -! numcoord - number of values in array coordlist. -! idrsnum - Data Representation Template Number ( see Code Table 5.0 ) -! idrstmpl - Contains the data values for the specified Data Representation -! Template ( N=idrsnum ). Each element of this integer -! array contains an entry (in the order specified) of Data -! Representation Template 5.N -! Note that some values in this template (eg. reference -! values, number of bits, etc...) may be changed by the -! data packing algorithms. -! Use this to specify scaling factors and order of -! spatial differencing, if desired. -! idrstmplen - Max dimension of idrstmpl() -! fld() - Array of data points to pack. -! ngrdpts - Number of data points in grid. -! i.e. size of fld and bmap. -! ibmap - Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! bmap() - Logical*1 array containing bitmap to be added. -! ( if ibmap=0 or ibmap=254) -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. Cannot add new section. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 3 or 7. -! 5 = Could not find requested Product Definition Template. -! 6 = Section 3 (GDS) not previously defined in message -! 7 = Tried to use unsupported Data Representationi Template -! 8 = Specified use of a previously defined bitmap, but one -! does not exist in the GRIB message. -! 9 = GDT of one of 5.50 through 5.53 required to pack -! using DRT 5.51 -! 10 = Error packing data field. -! -! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow -! Section 1 or Section 7 in a GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gribend -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-02 -! -! ABSTRACT: This subroutine finalizes a GRIB message after all grids -! and fields have been added. It adds the End Section ( "7777" ) -! to the end of the GRIB message and calculates the length and stores -! it in the appropriate place in Section 0. -! This routine is used with routines "gribcreate", "addlocal", "addgrid", -! and "addfield" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-02 Gilbert -! -! USAGE: CALL gribend(cgrib,lcgrib,lengrib,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lengrib - Length of the final GRIB2 message in octets (bytes) -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 7. -! -! REMARKS: This routine is intended for use with routines "gribcreate", -! "addlocal", "addgrid", and "addfield" to create a complete -! GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gb_info -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25 -! -! ABSTRACT: This subroutine searches through a GRIB2 message and -! returns the number of gridded fields found in the message and -! the number (and maximum size) of Local Use Sections. -! Also various checks are performed -! to see if the message is a valid GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-25 Gilbert -! -! USAGE: CALL gb_info(cgrib,lcgrib,listsec0,listsec1, -! & numfields,numlocal,maxlocal,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message in array cgrib. -! -! OUTPUT ARGUMENT LIST: -! listsec0 - Contains information decoded from GRIB Indicator Section 0. -! Must be dimensioned >= 2. -! listsec0(1)=Discipline-GRIB Master Table Number -! (see Code Table 0.0) -! listsec0(2)=GRIB Edition Number (currently 2) -! listsec0(3)=Length of GRIB message -! listsec1 - Contains information read from GRIB Identification Section 1. -! Must be dimensioned >= 13. -! listsec1(1)=Id of orginating centre (Common Code Table C-1) -! listsec1(2)=Id of orginating sub-centre (local table) -! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0) -! listsec1(4)=GRIB Local Tables Version Number -! listsec1(5)=Significance of Reference Time (Code Table 1.1) -! listsec1(6)=Reference Time - Year (4 digits) -! listsec1(7)=Reference Time - Month -! listsec1(8)=Reference Time - Day -! listsec1(9)=Reference Time - Hour -! listsec1(10)=Reference Time - Minute -! listsec1(11)=Reference Time - Second -! listsec1(12)=Production status of data (Code Table 1.2) -! listsec1(13)=Type of processed data (Code Table 1.3) -! numfields- The number of gridded fields found in the GRIB message. -! numlocal - The number of Local Use Sections ( Section 2 ) found in -! the GRIB message. -! maxlocal- The size of the largest Local Use Section ( Section 2 ). -! Can be used to ensure that the return array passed -! to subroutine getlocal is dimensioned large enough. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = Could not find Section 1, where expected. -! 4 = End string "7777" found, but not where expected. -! 5 = End string "7777" not found at end of message. -! 6 = Invalid section number found. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getlocal -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25 -! -! ABSTRACT: This subroutine returns the contents of Section 2 ( Local -! Use Section ) from a GRIB2 message. Since there can be multiple -! occurrences of Section 2 within a GRIB message, the calling routine -! indicates which occurrence is being requested with the localnum argument. -! -! PROGRAM HISTORY LOG: -! 2000-05-25 Gilbert -! -! USAGE: CALL getlocal(cgrib,lcgrib,localnum,csec2,lcsec2,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message in array cgrib. -! localnum - The nth occurrence of Section 2 requested. -! -! OUTPUT ARGUMENT LIST: -! csec2 - Character array containing information read from -! Section 2. -! The dimension of this array can be obtained in advance -! from argument maxlocal, which is returned from subroutine -! gb_info. -! lcsec2 - Number of bytes of character array csec2 read from -! Section 2. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = The section 2 request number was not positive. -! 4 = End string "7777" found, but not where expected. -! 5 = End string "7777" not found at end of message. -! 6 = GRIB message did not contain the requested number of -! Local Use Sections. -! -! REMARKS: Note that subroutine gribinfo can be used to first determine -! how many Local Use sections exist in a given GRIB message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_getfld -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine returns the Grid Definition, Product Definition, -! Bit-map ( if applicable ), and the unpacked data for a given data -! field. All of the information returned is stored in a derived -! type variable, gfld. Gfld is of type gribfield, which is defined -! in module grib_mod, so users of this routine will need to include -! the line "USE GRIB_MOD" in their calling routine. Each component of the -! gribfield type is described in the OUTPUT ARGUMENT LIST section below. -! -! Since there can be multiple data fields packed into a GRIB2 -! message, the calling routine indicates which field is being requested -! with the ifldnum argument. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! 2002-01-24 Gilbert - Changed to pass back derived type gribfield -! variable through argument list, instead of -! having many different arguments. -! -! USAGE: CALL gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message array cgrib. -! ifldnum - Specifies which field in the GRIB2 message to return. -! unpack - Logical value indicating whether to unpack bitmap/data -! .true. = unpack bitmap and data values -! .false. = do not unpack bitmap and data values -! expand - Boolean value indicating whether the data points should be -! expanded to the correspond grid, if a bit-map is present. -! 1 = if possible, expand data field to grid, inserting zero -! values at gridpoints that are bitmapped out. -! (SEE REMARKS2) -! 0 = do not expand data field, leaving it an array of -! consecutive data points for each "1" in the bitmap. -! This argument is ignored if unpack == 0 OR if the -! returned field does not contain a bit-map. -! -! OUTPUT ARGUMENT LIST: -! gfld - derived type gribfield ( defined in module grib_mod ) -! ( NOTE: See Remarks Section ) -! gfld%version = GRIB edition number ( currently 2 ) -! gfld%discipline = Message Discipline ( see Code Table 0.0 ) -! gfld%idsect() = Contains the entries in the Identification -! Section ( Section 1 ) -! This element is actually a pointer to an array -! that holds the data. -! gfld%idsect(1) = Identification of originating Centre -! ( see Common Code Table C-1 ) -! 7 - US National Weather Service -! gfld%idsect(2) = Identification of originating Sub-centre -! gfld%idsect(3) = GRIB Master Tables Version Number -! ( see Code Table 1.0 ) -! 0 - Experimental -! 1 - Initial operational version number -! gfld%idsect(4) = GRIB Local Tables Version Number -! ( see Code Table 1.1 ) -! 0 - Local tables not used -! 1-254 - Number of local tables version used -! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -! 0 - Analysis -! 1 - Start of forecast -! 2 - Verifying time of forecast -! 3 - Observation time -! gfld%idsect(6) = Year ( 4 digits ) -! gfld%idsect(7) = Month -! gfld%idsect(8) = Day -! gfld%idsect(9) = Hour -! gfld%idsect(10) = Minute -! gfld%idsect(11) = Second -! gfld%idsect(12) = Production status of processed data -! ( see Code Table 1.3 ) -! 0 - Operational products -! 1 - Operational test products -! 2 - Research products -! 3 - Re-analysis products -! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -! 0 - Analysis products -! 1 - Forecast products -! 2 - Analysis and forecast products -! 3 - Control forecast products -! 4 - Perturbed forecast products -! 5 - Control and perturbed forecast products -! 6 - Processed satellite observations -! 7 - Processed radar observations -! gfld%idsectlen = Number of elements in gfld%idsect(). -! gfld%ifldnum = field number within GRIB message -! gfld%griddef = Source of grid definition (see Code Table 3.0) -! 0 - Specified in Code table 3.1 -! 1 - Predetermined grid Defined by originating centre -! gfld%ngrdpts = Number of grid points in the defined grid. -! gfld%numoct_opt = Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! gfld%interp_opt = Interpretation of list for optional points -! definition. (Code Table 3.11) -! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -! gfld%igdtmpl() = Contains the data values for the specified Grid -! Definition Template ( NN=gfld%igdtnum ). Each -! element of this integer array contains an entry (in -! the order specified) of Grid Defintion Template 3.NN -! This element is actually a pointer to an array -! that holds the data. -! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -! entries in Grid Defintion Template 3.NN -! ( NN=gfld%igdtnum ). -! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -! contains the number of grid points contained in -! each row ( or column ). (part of Section 3) -! This element is actually a pointer to an array -! that holds the data. This pointer is nullified -! if gfld%numoct_opt=0. -! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. This value -! is set to zero, if gfld%numoct_opt=0. -! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -! gfld%ipdtmpl() = Contains the data values for the specified Product -! Definition Template ( N=gfdl%ipdtnum ). Each element -! of this integer array contains an entry (in the -! order specified) of Product Defintion Template 4.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -! entries in Product Defintion Template 4.N -! ( N=gfdl%ipdtnum ). -! gfld%coord_list() = Real array containing floating point values -! intended to document the vertical discretisation -! associated to model data on hybrid coordinate -! vertical levels. (part of Section 4) -! This element is actually a pointer to an array -! that holds the data. -! gfld%num_coord = number of values in array gfld%coord_list(). -! gfld%ndpts = Number of data points unpacked and returned. -! gfld%idrtnum = Data Representation Template Number -! ( see Code Table 5.0) -! gfld%idrtmpl() = Contains the data values for the specified Data -! Representation Template ( N=gfld%idrtnum ). Each -! element of this integer array contains an entry -! (in the order specified) of Product Defintion -! Template 5.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -! of entries in Data Representation Template 5.N -! ( N=gfld%idrtnum ). -! gfld%unpacked = logical value indicating whether the bitmap and -! data values were unpacked. If false, -! gfld%bmap and gfld%fld pointers are nullified. -! gfld%expanded = Logical value indicating whether the data field -! was expanded to the grid in the case where a -! bit-map is present. If true, the data points in -! gfld%fld match the grid points and zeros were -! inserted at grid points where data was bit-mapped -! out. If false, the data values in gfld%fld were -! not expanded to the grid and are just a consecutive -! array of data points corresponding to each value of -! "1" in gfld%bmap. -! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! gfld%bmap() = Logical*1 array containing decoded bitmap, -! if ibmap=0 or ibap=254. Otherwise nullified. -! This element is actually a pointer to an array -! that holds the data. -! gfld%fld() = Array of gfld%ndpts unpacked data points. -! This element is actually a pointer to an array -! that holds the data. -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = The data field request number was not positive. -! 4 = End string "7777" found, but not where expected. -! 6 = GRIB message did not contain the requested number of -! data fields. -! 7 = End string "7777" not found at end of message. -! 8 = Unrecognized Section encountered. -! 9 = Data Representation Template 5.NN not yet implemented. -! 15 = Error unpacking Section 1. -! 10 = Error unpacking Section 3. -! 11 = Error unpacking Section 4. -! 12 = Error unpacking Section 5. -! 13 = Error unpacking Section 6. -! 14 = Error unpacking Section 7. -! -! REMARKS: Note that derived type gribfield contains pointers to many -! arrays of data. The memory for these arrays is allocated -! when the values in the arrays are set, to help minimize -! problems with array overloading. Because of this users -! are encouraged to free up this memory, when it is no longer -! needed, by an explicit call to subroutine gf_free. -! ( i.e. CALL GF_FREE(GFLD) ) -! -! Subroutine gb_info can be used to first determine -! how many data fields exist in a given GRIB message. -! -! REMARKS2: It may not always be possible to expand a bit-mapped data field. -! If a pre-defined bit-map is used and not included in the GRIB2 -! message itself, this routine would not have the necessary -! information to expand the data. In this case, gfld%expanded would -! would be set to 0 (false), regardless of the value of input -! argument expand. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gf_free -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 -! -! ABSTRACT: This subroutine frees up memory that was used to store -! array values in derived type gribfield. -! -! PROGRAM HISTORY LOG: -! 2000-05-26 Gilbert -! -! USAGE: CALL gf_free(gfld) -! INPUT ARGUMENT LIST: -! gfld - derived type gribfield ( defined in module grib_mod ) -! -! OUTPUT ARGUMENT LIST: -! gfld - derived type gribfield ( defined in module grib_mod ) -! gfld%version = GRIB edition number -! gfld%discipline = Message Discipline ( see Code Table 0.0 ) -! gfld%idsect() = Contains the entries in the Identification -! Section ( Section 1 ) -! This element is actually a pointer to an array -! that holds the data. -! gfld%idsect(1) = Identification of originating Centre -! ( see Common Code Table C-1 ) -! gfld%idsect(2) = Identification of originating Sub-centre -! gfld%idsect(3) = GRIB Master Tables Version Number -! ( see Code Table 1.0 ) -! gfld%idsect(4) = GRIB Local Tables Version Number -! ( see Code Table 1.1 ) -! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -! gfld%idsect(6) = Year ( 4 digits ) -! gfld%idsect(7) = Month -! gfld%idsect(8) = Day -! gfld%idsect(9) = Hour -! gfld%idsect(10) = Minute -! gfld%idsect(11) = Second -! gfld%idsect(12) = Production status of processed data -! ( see Code Table 1.3 ) -! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -! gfld%idsectlen = Number of elements in gfld%idsect(). -! gfld%ifldnum = field number within GRIB message -! gfld%griddef = Source of grid definition (see Code Table 3.0) -! gfld%ngrdpts = Number of grid points in the defined grid. -! gfld%numoct_opt = Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! gfld%interp_opt = Interpretation of list for optional points -! definition. (Code Table 3.11) -! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -! gfld%igdtmpl() = Contains the data values for the specified Grid -! Definition Template ( NN=gfld%igdtnum ). Each -! element of this integer array contains an entry (in -! the order specified) of Grid Defintion Template 3.NN -! This element is actually a pointer to an array -! that holds the data. -! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -! entries in Grid Defintion Template 3.NN -! ( NN=gfld%igdtnum ). -! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -! contains the number of grid points contained in -! each row ( or column ). (part of Section 3) -! This element is actually a pointer to an array -! that holds the data. This pointer is nullified -! if gfld%numoct_opt=0. -! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. This value -! is set to zero, if gfld%numoct_opt=0. -! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -! gfld%ipdtmpl() = Contains the data values for the specified Product -! Definition Template ( N=gfdl%ipdtnum ). Each element -! of this integer array contains an entry (in the -! order specified) of Product Defintion Template 4.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -! entries in Product Defintion Template 4.N -! ( N=gfdl%ipdtnum ). -! gfld%coord_list() = Real array containing floating point values -! intended to document the vertical discretisation -! associated to model data on hybrid coordinate -! vertical levels. (part of Section 4) -! This element is actually a pointer to an array -! that holds the data. -! gfld%num_coord = number of values in array gfld%coord_list(). -! gfld%ndpts = Number of data points unpacked and returned. -! gfld%idrtnum = Data Representation Template Number -! ( see Code Table 5.0) -! gfld%idrtmpl() = Contains the data values for the specified Data -! Representation Template ( N=gfld%idrtnum ). Each -! element of this integer array contains an entry -! (in the order specified) of Product Defintion -! Template 5.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -! of entries in Data Representation Template 5.N -! ( N=gfld%idrtnum ). -! gfld%unpacked = logical value indicating whether the bitmap and -! data values were unpacked. If false, gfld%ndpts -! is set to zero, and gfld%bmap and gfld%fld -! pointers are nullified. -! gfld%expanded = Logical value indicating whether the data field -! was expanded to the grid in the case where a -! bit-map is present. If true, the data points in -! gfld%fld match the grid points and zeros were -! inserted at grid points where data was bit-mapped -! out. If false, the data values in gfld%fld were -! not expanded to the grid and are just a consecutive -! array of data points corresponding to each value of -! "1" in gfld%bmap. -! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! gfld%bmap() - Logical*1 array containing decoded bitmap, -! if ibmap=0 or ibap=254. Otherwise nullified. -! This element is actually a pointer to an array -! that holds the data. -! gfld%fld() = Array of gfld%ndpts unpacked data points. -! This element is actually a pointer to an array -! that holds the data. -! -! REMARKS: -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB2 FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED. -C THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP -C AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND -C PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER -C OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS NUMBER IS RETURNED ALONG WITH -C THE ASSOCIATED UNPACKED PARAMETERS. THE BITMAP (IF ANY), -C AND THE DATA VALUES ARE UNPACKED ONLY IF ARGUMENT "UNPACK" IS SET TO -C TRUE. IF THE GRIB FIELD IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C The decoded information for the selected GRIB field -C is returned in a derived type variable, gfld. -C Gfld is of type gribfield, which is defined -C in module grib_mod, so users of this routine will need to include -C the line "USE GRIB_MOD" in their calling routine. Each component of the -C gribfield type is described in the OUTPUT ARGUMENT LIST section below. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C 2002-01-11 GILBERT MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2 -C -C USAGE: CALL GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT, -C & UNPACK,K,GFLD,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE. -C FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING -C THIS ROUTINE. -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE. -C IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE -C CALLING THIS ROUTINE. -C >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T -C ALREADY EXIST. -C =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX -C DOESN"T ALREADY EXIST. -C <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI). -C =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB. -C J INTEGER NUMBER OF FIELDS TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD -C ( IF = -1, ACCEPT ANY DISCIPLINE) -C ( SEE CODE TABLE 0.0 ) -C 0 - Meteorological products -C 1 - Hydrological products -C 2 - Land surface products -C 3 - Space products -C 10 - Oceanographic products -C JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION -C (=-9999 FOR WILDCARD) -C JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE -C ( SEE COMMON CODE TABLE C-1 ) -C JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE -C JIDS(3) = GRIB MASTER TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER -C ( SEE CODE TABLE 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C JIDS(6) = YEAR ( 4 DIGITS ) -C JIDS(7) = MONTH -C JIDS(8) = DAY -C JIDS(9) = HOUR -C JIDS(10) = MINUTE -C JIDS(11) = SECOND -C JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA -C ( SEE CODE TABLE 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N) -C ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY ) -C JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION -C TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M) -C ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY ) -C JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION -C TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH -C (=-9999 FOR WILDCARD) -C UNPACK LOGICAL VALUE INDICATING WHETHER TO UNPACK BITMAP/DATA -C .TRUE. = UNPACK BITMAP AND DATA VALUES -C .FALSE. = DO NOT UNPACK BITMAP AND DATA VALUES -C -C OUTPUT ARGUMENTS: -C K INTEGER FIELD NUMBER UNPACKED -C gfld - derived type gribfield ( defined in module grib_mod ) -C ( NOTE: See Remarks Section ) -C gfld%version = GRIB edition number ( currently 2 ) -C gfld%discipline = Message Discipline ( see Code Table 0.0 ) -C gfld%idsect() = Contains the entries in the Identification -C Section ( Section 1 ) -C This element is actually a pointer to an array -C that holds the data. -C gfld%idsect(1) = Identification of originating Centre -C ( see Common Code Table C-1 ) -C 7 - US National Weather Service -C gfld%idsect(2) = Identification of originating Sub-centre -C gfld%idsect(3) = GRIB Master Tables Version Number -C ( see Code Table 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C gfld%idsect(4) = GRIB Local Tables Version Number -C ( see Code Table 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C gfld%idsect(6) = Year ( 4 digits ) -C gfld%idsect(7) = Month -C gfld%idsect(8) = Day -C gfld%idsect(9) = Hour -C gfld%idsect(10) = Minute -C gfld%idsect(11) = Second -C gfld%idsect(12) = Production status of processed data -C ( see Code Table 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C gfld%idsectlen = Number of elements in gfld%idsect(). -C gfld%local() = Pointer to character array containing contents -C of Local Section 2, if included -C gfld%locallen = length of array gfld%local() -C gfld%ifldnum = field number within GRIB message -C gfld%griddef = Source of grid definition (see Code Table 3.0) -C 0 - Specified in Code table 3.1 -C 1 - Predetermined grid Defined by originating centre -C gfld%ngrdpts = Number of grid points in the defined grid. -C gfld%numoct_opt = Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C gfld%interp_opt = Interpretation of list for optional points -C definition. (Code Table 3.11) -C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -C gfld%igdtmpl() = Contains the data values for the specified Grid -C Definition Template ( NN=gfld%igdtnum ). Each -C element of this integer array contains an entry (in -C the order specified) of Grid Defintion Template 3.NN -C This element is actually a pointer to an array -C that holds the data. -C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -C entries in Grid Defintion Template 3.NN -C ( NN=gfld%igdtnum ). -C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -C contains the number of grid points contained in -C each row ( or column ). (part of Section 3) -C This element is actually a pointer to an array -C that holds the data. This pointer is nullified -C if gfld%numoct_opt=0. -C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -C in array ideflist. i.e. number of rows ( or columns ) -C for which optional grid points are defined. This value -C is set to zero, if gfld%numoct_opt=0. -C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -C gfld%ipdtmpl() = Contains the data values for the specified Product -C Definition Template ( N=gfdl%ipdtnum ). Each element -C of this integer array contains an entry (in the -C order specified) of Product Defintion Template 4.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -C entries in Product Defintion Template 4.N -C ( N=gfdl%ipdtnum ). -C gfld%coord_list() = Real array containing floating point values -C intended to document the vertical discretisation -C associated to model data on hybrid coordinate -C vertical levels. (part of Section 4) -C This element is actually a pointer to an array -C that holds the data. -C gfld%num_coord = number of values in array gfld%coord_list(). -C gfld%ndpts = Number of data points unpacked and returned. -C gfld%idrtnum = Data Representation Template Number -C ( see Code Table 5.0) -C gfld%idrtmpl() = Contains the data values for the specified Data -C Representation Template ( N=gfld%idrtnum ). Each -C element of this integer array contains an entry -C (in the order specified) of Product Defintion -C Template 5.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -C of entries in Data Representation Template 5.N -C ( N=gfld%idrtnum ). -C gfld%unpacked = logical value indicating whether the bitmap and -C data values were unpacked. If false, -C gfld%bmap and gfld%fld pointers are nullified. -C gfld%expanded = Logical value indicating whether the data field -C was expanded to the grid in the case where a -C bit-map is present. If true, the data points in -C gfld%fld match the grid points and zeros were -C inserted at grid points where data was bit-mapped -C out. If false, the data values in gfld%fld were -C not expanded to the grid and are just a consecutive -C array of data points corresponding to each value of -C "1" in gfld%bmap. -C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -C 0 = bitmap applies and is included in Section 6. -C 1-253 = Predefined bitmap applies -C 254 = Previously defined bitmap applies to this field -C 255 = Bit map does not apply to this product. -C gfld%bmap() = Logical*1 array containing decoded bitmap, -C if ibmap=0 or ibap=254. Otherwise nullified. -C This element is actually a pointer to an array -C that holds the data. -C gfld%fld() = Array of gfld%ndpts unpacked data points. -C This element is actually a pointer to an array -C that holds the data. -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX -C 97 ERROR READING GRIB FILE -C 99 REQUEST NOT FOUND -C OTHER GF_GETFLD GRIB2 UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETIDX GET INDEX -C GETGB2S SEARCH INDEX RECORDS -C GETGB2R READ AND UNPACK GRIB RECORD -C GF_FREE FREES MEMORY USED BY GFLD ( SEE REMARKS ) -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/grib_mod.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/grib_mod.mod deleted file mode 100644 index 229d64977b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/grib_mod.mod +++ /dev/null @@ -1,42 +0,0 @@ -GFORTRAN module created from gribmod.f on Mon Nov 16 16:42:53 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'grib_mod' 'grib_mod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(UNKNOWN 0 ()) 0 0 () () 0 () ()) -3 'g2_version' 'grib_mod' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (CHARACTER 1 ((CONSTANT (INTEGER 4 ()) 0 '12'))) 0 0 () () 0 () -()) -4 'gribfield' 'grib_mod' 1 ((DERIVED UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(UNKNOWN 0 ()) 0 0 () () 0 ((5 'version' (INTEGER 4 ()) () 0 0 ()) (6 -'discipline' (INTEGER 4 ()) () 0 0 ()) (7 'idsect' (INTEGER 4 ()) (1 -DEFERRED () ()) 1 1 ()) (8 'idsectlen' (INTEGER 4 ()) () 0 0 ()) (9 -'local' (CHARACTER 1 ((CONSTANT (INTEGER 4 ()) 0 '1'))) (1 DEFERRED () ()) -1 1 ()) (10 'locallen' (INTEGER 4 ()) () 0 0 ()) (11 'ifldnum' (INTEGER -4 ()) () 0 0 ()) (12 'griddef' (INTEGER 4 ()) () 0 0 ()) (13 'ngrdpts' ( -INTEGER 4 ()) () 0 0 ()) (14 'numoct_opt' (INTEGER 4 ()) () 0 0 ()) (15 -'interp_opt' (INTEGER 4 ()) () 0 0 ()) (16 'num_opt' (INTEGER 4 ()) () 0 -0 ()) (17 'list_opt' (INTEGER 4 ()) (1 DEFERRED () ()) 1 1 ()) (18 -'igdtnum' (INTEGER 4 ()) () 0 0 ()) (19 'igdtlen' (INTEGER 4 ()) () 0 0 -()) (20 'igdtmpl' (INTEGER 4 ()) (1 DEFERRED () ()) 1 1 ()) (21 'ipdtnum' -(INTEGER 4 ()) () 0 0 ()) (22 'ipdtlen' (INTEGER 4 ()) () 0 0 ()) (23 -'ipdtmpl' (INTEGER 4 ()) (1 DEFERRED () ()) 1 1 ()) (24 'num_coord' ( -INTEGER 4 ()) () 0 0 ()) (25 'coord_list' (REAL 4 ()) (1 DEFERRED () ()) -1 1 ()) (26 'ndpts' (INTEGER 4 ()) () 0 0 ()) (27 'idrtnum' (INTEGER 4 ()) -() 0 0 ()) (28 'idrtlen' (INTEGER 4 ()) () 0 0 ()) (29 'idrtmpl' ( -INTEGER 4 ()) (1 DEFERRED () ()) 1 1 ()) (30 'unpacked' (LOGICAL 4 ()) () -0 0 ()) (31 'expanded' (LOGICAL 4 ()) () 0 0 ()) (32 'ibmap' (INTEGER 4 -()) () 0 0 ()) (33 'bmap' (LOGICAL 1 ()) (1 DEFERRED () ()) 1 1 ()) (34 -'fld' (REAL 4 ()) (1 DEFERRED () ()) 1 1 ())) PUBLIC ()) -) - -('gribfield' 0 4 'g2_version' 0 3 'grib_mod' 0 2) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribcreate.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribcreate.f deleted file mode 100755 index 88547aaa9b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribcreate.f +++ /dev/null @@ -1,123 +0,0 @@ - subroutine gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gribcreate -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-04-28 -! -! ABSTRACT: This subroutine initializes a new GRIB2 message and packs -! GRIB2 sections 0 (Indicator Section) and 1 (Identification Section). -! This routine is used with routines "addlocal", "addgrid", "addfield", -! and "gribend" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! Also, a call to gribend is required to complete GRIB2 message -! after all fields have been added. -! -! PROGRAM HISTORY LOG: -! 2000-04-28 Gilbert -! -! USAGE: CALL gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! listsec0 - Contains information needed for GRIB Indicator Section 0. -! Must be dimensioned >= 2. -! listsec0(1)=Discipline-GRIB Master Table Number -! (see Code Table 0.0) -! listsec0(2)=GRIB Edition Number (currently 2) -! listsec1 - Contains information needed for GRIB Identification Section 1. -! Must be dimensioned >= 13. -! listsec1(1)=Id of orginating centre (Common Code Table C-1) -! listsec1(2)=Id of orginating sub-centre (local table) -! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0) -! listsec1(4)=GRIB Local Tables Version Number (Code Table 1.1) -! listsec1(5)=Significance of Reference Time (Code Table 1.2) -! listsec1(6)=Reference Time - Year (4 digits) -! listsec1(7)=Reference Time - Month -! listsec1(8)=Reference Time - Day -! listsec1(9)=Reference Time - Hour -! listsec1(10)=Reference Time - Minute -! listsec1(11)=Reference Time - Second -! listsec1(12)=Production status of data (Code Table 1.3) -! listsec1(13)=Type of processed data (Code Table 1.4) -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! ierr - Error return code. -! 0 = no error -! 1 = Tried to use for version other than GRIB Edition 2 -! -! REMARKS: This routine is intended for use with routines "addlocal", -! "addgrid", "addfield", and "gribend" to create a complete -! GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(inout) :: cgrib(lcgrib) - integer,intent(in) :: listsec0(*),listsec1(*) - integer,intent(in) :: lcgrib - integer,intent(out) :: ierr - - character(len=4),parameter :: grib='GRIB' - integer,parameter :: zero=0,one=1 - integer,parameter :: mapsec1len=13 - integer,parameter :: - & mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /) - integer lensec0,iofst,ibeg - - ierr=0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'gribcreate: can only code GRIB edition 2.' - ierr=1 - return - endif -! -! Pack Section 0 - Indicator Section -! ( except for total length of GRIB message ) -! -! cgrib=' ' - cgrib(1)=grib(1:1) ! Beginning of GRIB message - cgrib(2)=grib(2:2) - cgrib(3)=grib(3:3) - cgrib(4)=grib(4:4) - call sbyte(cgrib,zero,32,16) ! reserved for future use - call sbyte(cgrib,listsec0(1),48,8) ! Discipline - call sbyte(cgrib,listsec0(2),56,8) ! GRIB edition number - lensec0=16 ! bytes (octets) -! -! Pack Section 1 - Identification Section -! - ibeg=lensec0*8 ! Calculate offset for beginning of section 1 - iofst=ibeg+32 ! leave space for length of section - call sbyte(cgrib,one,iofst,8) ! Store section number ( 1 ) - iofst=iofst+8 - ! - ! Pack up each input value in array listsec1 into the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapsec1. - ! - do i=1,mapsec1len - nbits=mapsec1(i)*8 - call sbyte(cgrib,listsec1(i),iofst,nbits) - iofst=iofst+nbits - enddo - ! - ! Calculate length of section 1 and store it in octets - ! 1-4 of section 1. - ! - lensec1=(iofst-ibeg)/8 - call sbyte(cgrib,lensec1,ibeg,32) -! -! Put current byte total of message into Section 0 -! - call sbyte(cgrib,zero,64,32) - call sbyte(cgrib,lensec0+lensec1,96,32) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribend.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribend.f deleted file mode 100755 index c59c063477..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribend.f +++ /dev/null @@ -1,126 +0,0 @@ - subroutine gribend(cgrib,lcgrib,lengrib,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gribend -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-02 -! -! ABSTRACT: This subroutine finalizes a GRIB message after all grids -! and fields have been added. It adds the End Section ( "7777" ) -! to the end of the GRIB message and calculates the length and stores -! it in the appropriate place in Section 0. -! This routine is used with routines "gribcreate", "addlocal", "addgrid", -! and "addfield" to create a complete GRIB2 message. Subroutine -! gribcreate must be called first to initialize a new GRIB2 message. -! -! PROGRAM HISTORY LOG: -! 2000-05-02 Gilbert -! -! USAGE: CALL gribend(cgrib,lcgrib,lengrib,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lcgrib - Maximum length (bytes) of array cgrib. -! -! OUTPUT ARGUMENT LIST: -! cgrib - Character array to contain the GRIB2 message -! lengrib - Length of the final GRIB2 message in octets (bytes) -! ierr - Error return code. -! 0 = no error -! 1 = GRIB message was not initialized. Need to call -! routine gribcreate first. -! 2 = GRIB message already complete. -! 3 = Sum of Section byte counts doesn't add to total byte count. -! 4 = Previous Section was not 7. -! -! REMARKS: This routine is intended for use with routines "gribcreate", -! "addlocal", "addgrid", and "addfield" to create a complete -! GRIB2 message. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(inout) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(out) :: lengrib,ierr - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4):: ctemp - integer iofst,ibeg,lencurr,len - - ierr=0 -! -! Check to see if beginning of GRIB message exists -! - ctemp=cgrib(1)//cgrib(2)//cgrib(3)//cgrib(4) - if ( ctemp.ne.grib ) then - print *,'gribend: GRIB not found in given message.' - ierr=1 - return - endif -! -! Get current length of GRIB message -! - call gbyte(cgrib,lencurr,96,32) -! -! Check to see if GRIB message is already complete -! -! ctemp=cgrib(lencurr-3)//cgrib(lencurr-2)//cgrib(lencurr-1) -! & //cgrib(lencurr) -! if ( ctemp.eq.c7777 ) then -! print *,'gribend: GRIB message already complete.' -! ierr=2 -! return -! endif -! -! Loop through all current sections of the GRIB message to -! find the last section number. -! - len=16 ! Length of Section 0 - do - ! Get number and length of next section - iofst=len*8 - call gbyte(cgrib,ilen,iofst,32) - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) - len=len+ilen - ! Exit loop if last section reached - if ( len.eq.lencurr ) exit - ! If byte count for each section doesn't match current - ! total length, then there is a problem. - if ( len.gt.lencurr ) then - print *,'gribend: Section byte counts don''t add to total.' - print *,'gribend: Sum of section byte counts = ',len - print *,'gribend: Total byte count in Section 0 = ',lencurr - ierr=3 - return - endif - enddo -! -! Can only add End Section (Section 8) after Section 7. -! - if ( isecnum.ne.7 ) then - print *,'gribend: Section 8 can only be added after Section 7.' - print *,'gribend: Section ',isecnum,' was the last found in', - & ' given GRIB message.' - ierr=4 - return - endif -! -! Add Section 8 - End Section -! - cgrib(lencurr+1:lencurr+4)=c7777 - -! -! Update current byte total of message in Section 0 -! - lengrib=lencurr+4 - call sbyte(cgrib,lengrib,96,32) - - return - end - - - - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribinfo.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribinfo.f deleted file mode 100755 index 6f77b82acc..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribinfo.f +++ /dev/null @@ -1,243 +0,0 @@ - subroutine gribinfo(cgrib,lcgrib,listsec0,listsec1, - & numlocal,numfields,maxvals,ierr) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: gribinfo -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25 -! -! ABSTRACT: This subroutine searches through a GRIB2 message and -! returns the number of Local Use Sections and number of gridded -! fields found in the message. It also performs various checks -! to see if the message is a valid GRIB2 message. -! Last, a list of safe array dimensions is returned for use in -! allocating return arrays from routines getlocal, gettemplates, and -! getfields. (See maxvals and REMARKS) -! -! PROGRAM HISTORY LOG: -! 2000-05-25 Gilbert -! -! USAGE: CALL gribinfo(cgrib,lcgrib,listsec0,listsec1, -! & numlocal,numfields,ierr) -! INPUT ARGUMENT LIST: -! cgrib - Character array that contains the GRIB2 message -! lcgrib - Length (in bytes) of GRIB message in array cgrib. -! -! OUTPUT ARGUMENT LIST: -! listsec0 - Contains information decoded from GRIB Indicator Section 0. -! Must be dimensioned >= 2. -! listsec0(1)=Discipline-GRIB Master Table Number -! (see Code Table 0.0) -! listsec0(2)=GRIB Edition Number (currently 2) -! listsec0(3)=Length of GRIB message -! listsec1 - Contains information read from GRIB Identification Section 1. -! Must be dimensioned >= 13. -! listsec1(1)=Id of orginating centre (Common Code Table C-1) -! listsec1(2)=Id of orginating sub-centre (local table) -! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0) -! listsec1(4)=GRIB Local Tables Version Number -! listsec1(5)=Significance of Reference Time (Code Table 1.1) -! listsec1(6)=Reference Time - Year (4 digits) -! listsec1(7)=Reference Time - Month -! listsec1(8)=Reference Time - Day -! listsec1(9)=Reference Time - Hour -! listsec1(10)=Reference Time - Minute -! listsec1(11)=Reference Time - Second -! listsec1(12)=Production status of data (Code Table 1.2) -! listsec1(13)=Type of processed data (Code Table 1.3) -! numlocal - The number of Local Use Sections ( Section 2 ) found in -! the GRIB message. -! numfields- The number of gridded fieldse found in the GRIB message. -! maxvals()- The maximum number of elements that could be returned -! in various arrays from this GRIB2 message. (see REMARKS) -! maxvals(1)=max length of local section 2 (for getlocal) -! maxvals(2)=max length of GDS Template (for gettemplates -! and getfield) -! maxvals(3)=max length of GDS Optional list (for getfield) -! maxvals(4)=max length of PDS Template (for gettemplates -! and getfield) -! maxvals(5)=max length of PDS Optional list (for getfield) -! maxvals(6)=max length of DRS Template (for gettemplates -! and getfield) -! maxvals(7)=max number of gridpoints (for getfield) -! ierr - Error return code. -! 0 = no error -! 1 = Beginning characters "GRIB" not found. -! 2 = GRIB message is not Edition 2. -! 3 = Could not find Section 1, where expected. -! 4 = End string "7777" found, but not where expected. -! 5 = End string "7777" not found at end of message. -! -! REMARKS: Array maxvals contains the maximum possible -! number of values that will be returned in argument arrays -! for routines getlocal, gettemplates, and getfields. -! Users can use this info to determine if their arrays are -! dimensioned large enough for the data that may be returned -! from the above routines, or to dynamically allocate arrays -! with a reasonable size. -! NOTE that the actual number of values in these arrays is returned -! from the routines and will likely be less than the values -! calculated by this routine. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cgrib(lcgrib) - integer,intent(in) :: lcgrib - integer,intent(out) :: listsec0(3),listsec1(13),maxvals(7) - integer,intent(out) :: numlocal,numfields,ierr - - character(len=4),parameter :: grib='GRIB',c7777='7777' - character(len=4) :: ctemp - integer,parameter :: zero=0,one=1 - integer,parameter :: mapsec1len=13 - integer,parameter :: - & mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /) - integer iofst,ibeg,istart - - ierr=0 - numlocal=0 - numfields=0 - maxsec2len=1 - maxgdstmpl=1 - maxdeflist=1 - maxpdstmpl=1 - maxcoordlist=1 - maxdrstmpl=1 - maxgridpts=0 -! -! Check for beginning of GRIB message in the first 100 bytes -! - istart=0 - do j=1,100 - ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3) - if (ctemp.eq.grib ) then - istart=j - exit - endif - enddo - if (istart.eq.0) then - print *,'gribinfo: Beginning characters GRIB not found.' - ierr=1 - return - endif -! -! Unpack Section 0 - Indicator Section -! - iofst=8*(istart+5) - call gbyte(cgrib,listsec0(1),iofst,8) ! Discipline - iofst=iofst+8 - call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number - iofst=iofst+8 - iofst=iofst+32 - call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message - iofst=iofst+32 - listsec0(3)=lengrib - lensec0=16 - ipos=istart+lensec0 -! -! Currently handles only GRIB Edition 2. -! - if (listsec0(2).ne.2) then - print *,'gribinfo: can only decode GRIB edition 2.' - ierr=2 - return - endif -! -! Unpack Section 1 - Identification Section -! - call gbyte(cgrib,lensec1,iofst,32) ! Length of Section 1 - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Section number ( 1 ) - iofst=iofst+8 - if (isecnum.ne.1) then - print *,'gribinfo: Could not find section 1.' - ierr=3 - return - endif - ! - ! Unpack each input value in array listsec1 into the - ! the appropriate number of octets, which are specified in - ! corresponding entries in array mapsec1. - ! - do i=1,mapsec1len - nbits=mapsec1(i)*8 - call gbyte(cgrib,listsec1(i),iofst,nbits) - iofst=iofst+nbits - enddo - ipos=ipos+lensec1 -! -! Loop through the remaining sections keeping track of the -! length of each. Also count the number of times Section 2 -! and Section 4 appear. -! - do - ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3) - if (ctemp.eq.c7777 ) then - ipos=ipos+4 - if (ipos.ne.(istart+lengrib)) then - print *,'gribinfo: "7777" found, but not where expected.' - ierr=4 - return - endif - exit - endif - iofst=(ipos-1)*8 - call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section - iofst=iofst+32 - call gbyte(cgrib,isecnum,iofst,8) ! Get Section number - iofst=iofst+8 - ipos=ipos+lensec ! Update beginning of section pointer - if (ipos.gt.(istart+lengrib)) then - print *,'gribinfo: "7777" not found at end of GRIB message.' - ierr=5 - return - endif - if (isecnum.eq.2) then ! Local Section 2 - ! increment counter for total number of local sections found - ! and determine largest Section 2 in message - numlocal=numlocal+1 - lenposs=lensec-5 - if ( lenposs.gt.maxsec2len ) maxsec2len=lenposs - elseif (isecnum.eq.3) then - iofst=iofst+8 ! skip source of grid def. - call gbyte(cgrib,ngdpts,iofst,32) ! Get Num of Grid Points - iofst=iofst+32 - call gbyte(cgrib,nbyte,iofst,8) ! Get Num octets for opt. list - iofst=iofst+8 - if (ngdpts.gt.maxgridpts) maxgridpts=ngdpts - lenposs=lensec-14 - if ( lenposs.gt.maxgdstmpl ) maxgdstmpl=lenposs - if (nbyte.ne.0) then - lenposs=lenposs/nbyte - if ( lenposs.gt.maxdeflist ) maxdeflist=lenposs - endif - elseif (isecnum.eq.4) then - numfields=numfields+1 - call gbyte(cgrib,numcoord,iofst,16) ! Get Num of Coord Values - iofst=iofst+16 - if (numcoord.ne.0) then - if (numcoord.gt.maxcoordlist) maxcoordlist=numcoord - endif - lenposs=lensec-9 - if ( lenposs.gt.maxpdstmpl ) maxpdstmpl=lenposs - elseif (isecnum.eq.5) then - lenposs=lensec-11 - if ( lenposs.gt.maxdrstmpl ) maxdrstmpl=lenposs - endif - - enddo - - maxvals(1)=maxsec2len - maxvals(2)=maxgdstmpl - maxvals(3)=maxdeflist - maxvals(4)=maxpdstmpl - maxvals(5)=maxcoordlist - maxvals(6)=maxdrstmpl - maxvals(7)=maxgridpts - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribmod.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribmod.f deleted file mode 100755 index 60825dc24a..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gribmod.f +++ /dev/null @@ -1,189 +0,0 @@ - module grib_mod -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! MODULE: grib_mod -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-23 -! -! ABSTRACT: This Fortran Module contains the declaration -! of derived type gribfield. -! If variable gfld is declared of type gribfield -! ( i.e. TYPE(GRIBFIELD) :: GFLD ), it would have the following componenets: -! -! gfld%version = GRIB edition number ( currently 2 ) -! gfld%discipline = Message Discipline ( see Code Table 0.0 ) -! gfld%idsect() = Contains the entries in the Identification -! Section ( Section 1 ) -! This element is actually a pointer to an array -! that holds the data. -! gfld%idsect(1) = Identification of originating Centre -! ( see Common Code Table C-1 ) -! 7 - US National Weather Service -! gfld%idsect(2) = Identification of originating Sub-centre -! gfld%idsect(3) = GRIB Master Tables Version Number -! ( see Code Table 1.0 ) -! 0 - Experimental -! 1 - Initial operational version number -! gfld%idsect(4) = GRIB Local Tables Version Number -! ( see Code Table 1.1 ) -! 0 - Local tables not used -! 1-254 - Number of local tables version used -! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -! 0 - Analysis -! 1 - Start of forecast -! 2 - Verifying time of forecast -! 3 - Observation time -! gfld%idsect(6) = Year ( 4 digits ) -! gfld%idsect(7) = Month -! gfld%idsect(8) = Day -! gfld%idsect(9) = Hour -! gfld%idsect(10) = Minute -! gfld%idsect(11) = Second -! gfld%idsect(12) = Production status of processed data -! ( see Code Table 1.3 ) -! 0 - Operational products -! 1 - Operational test products -! 2 - Research products -! 3 - Re-analysis products -! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -! 0 - Analysis products -! 1 - Forecast products -! 2 - Analysis and forecast products -! 3 - Control forecast products -! 4 - Perturbed forecast products -! 5 - Control and perturbed forecast products -! 6 - Processed satellite observations -! 7 - Processed radar observations -! gfld%idsectlen = Number of elements in gfld%idsect(). -! gfld%local() = Pointer to character array containing contents -! of Local Section 2, if included -! gfld%locallen = length of array gfld%local() -! gfld%ifldnum = field number within GRIB message -! gfld%griddef = Source of grid definition (see Code Table 3.0) -! 0 - Specified in Code table 3.1 -! 1 - Predetermined grid Defined by originating centre -! gfld%ngrdpts = Number of grid points in the defined grid. -! gfld%numoct_opt = Number of octets needed for each -! additional grid points definition. -! Used to define number of -! points in each row ( or column ) for -! non-regular grids. -! = 0, if using regular grid. -! gfld%interp_opt = Interpretation of list for optional points -! definition. (Code Table 3.11) -! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -! gfld%igdtmpl() = Contains the data values for the specified Grid -! Definition Template ( NN=gfld%igdtnum ). Each -! element of this integer array contains an entry (in -! the order specified) of Grid Defintion Template 3.NN -! This element is actually a pointer to an array -! that holds the data. -! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -! entries in Grid Defintion Template 3.NN -! ( NN=gfld%igdtnum ). -! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -! contains the number of grid points contained in -! each row ( or column ). (part of Section 3) -! This element is actually a pointer to an array -! that holds the data. This pointer is nullified -! if gfld%numoct_opt=0. -! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -! in array ideflist. i.e. number of rows ( or columns ) -! for which optional grid points are defined. This value -! is set to zero, if gfld%numoct_opt=0. -! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -! gfld%ipdtmpl() = Contains the data values for the specified Product -! Definition Template ( N=gfdl%ipdtnum ). Each element -! of this integer array contains an entry (in the -! order specified) of Product Defintion Template 4.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -! entries in Product Defintion Template 4.N -! ( N=gfdl%ipdtnum ). -! gfld%coord_list() = Real array containing floating point values -! intended to document the vertical discretisation -! associated to model data on hybrid coordinate -! vertical levels. (part of Section 4) -! This element is actually a pointer to an array -! that holds the data. -! gfld%num_coord = number of values in array gfld%coord_list(). -! gfld%ndpts = Number of data points unpacked and returned. -! gfld%idrtnum = Data Representation Template Number -! ( see Code Table 5.0) -! gfld%idrtmpl() = Contains the data values for the specified Data -! Representation Template ( N=gfld%idrtnum ). Each -! element of this integer array contains an entry -! (in the order specified) of Product Defintion -! Template 5.N. -! This element is actually a pointer to an array -! that holds the data. -! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -! of entries in Data Representation Template 5.N -! ( N=gfld%idrtnum ). -! gfld%unpacked = logical value indicating whether the bitmap and -! data values were unpacked. If false, -! gfld%bmap and gfld%fld pointers are nullified. -! gfld%expanded = Logical value indicating whether the data field -! was expanded to the grid in the case where a -! bit-map is present. If true, the data points in -! gfld%fld match the grid points and zeros were -! inserted at grid points where data was bit-mapped -! out. If false, the data values in gfld%fld were -! not expanded to the grid and are just a consecutive -! array of data points corresponding to each value of -! "1" in gfld%bmap. -! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -! 0 = bitmap applies and is included in Section 6. -! 1-253 = Predefined bitmap applies -! 254 = Previously defined bitmap applies to this field -! 255 = Bit map does not apply to this product. -! gfld%bmap() = Logical*1 array containing decoded bitmap, -! if ibmap=0 or ibap=254. Otherwise nullified. -! This element is actually a pointer to an array -! that holds the data. -! gfld%fld() = Array of gfld%ndpts unpacked data points. -! This element is actually a pointer to an array -! that holds the data. -! -! -! PROGRAM HISTORY LOG: -! 2002-01-23 Gilbert -! 2007-04-24 Vuong - Added GDT 3.204 Curvilinear Orthogonal Grids -! 2008-05-29 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid -! -! USAGE: use grib_mod -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=12) :: G2_VERSION="g2lib-1.1.8" - - type gribfield - integer :: version,discipline - integer,pointer,dimension(:) :: idsect - integer :: idsectlen - character(len=1),pointer,dimension(:) :: local - integer :: locallen - integer :: ifldnum - integer :: griddef,ngrdpts - integer :: numoct_opt,interp_opt,num_opt - integer,pointer,dimension(:) :: list_opt - integer :: igdtnum,igdtlen - integer,pointer,dimension(:) :: igdtmpl - integer :: ipdtnum,ipdtlen - integer,pointer,dimension(:) :: ipdtmpl - integer :: num_coord - real,pointer,dimension(:) :: coord_list - integer :: ndpts,idrtnum,idrtlen - integer,pointer,dimension(:) :: idrtmpl - logical :: unpacked - logical :: expanded - integer :: ibmap - logical*1,pointer,dimension(:) :: bmap - real,pointer,dimension(:) :: fld - end type gribfield - - end module diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gridtemplates.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gridtemplates.f deleted file mode 100755 index e1f36150d0..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gridtemplates.f +++ /dev/null @@ -1,417 +0,0 @@ - module gridtemplates -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! MODULE: gridtemplates -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09 -! -! ABSTRACT: This Fortran Module contains info on all the available -! GRIB2 Grid Definition Templates used in Section 3 (GDS). -! Each Template has three parts: The number of entries in the template -! (mapgridlen); A map of the template (mapgrid), which contains the -! number of octets in which to pack each of the template values; and -! a logical value (needext) that indicates whether the Template needs -! to be extended. In some cases the number of entries in a template -! can vary depending upon values specified in the "static" part of -! the template. ( See Template 3.120 as an example ) -! -! This module also contains two subroutines. Subroutine getgridtemplate -! returns the octet map for a specified Template number, and -! subroutine extgridtemplate will calculate the extended octet map -! of an appropriate template given values for the "static" part of the -! template. See docblocks below for the arguments and usage of these -! routines. -! -! NOTE: Array mapgrid contains the number of octets in which the -! corresponding template values will be stored. A negative value in -! mapgrid is used to indicate that the corresponding template entry can -! contain negative values. This information is used later when packing -! (or unpacking) the template data values. Negative data values in GRIB -! are stored with the left most bit set to one, and a negative number -! of octets value in mapgrid() indicates that this possibility should -! be considered. The number of octets used to store the data value -! in this case would be the absolute value of the negative value in -! mapgrid(). -! -! -! PROGRAM HISTORY LOG: -! 2000-05-09 Gilbert -! 2003-09-02 Gilbert - Added GDT 3.31 - Albers Equal Area -! 2007-04-24 Vuong - Added GDT 3.204 Curilinear Orthogonal Grids -! 2008-05-29 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid -! -! USAGE: use gridtemplates -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,parameter :: MAXLEN=200,MAXTEMP=25 - - type gridtemplate - integer :: template_num - integer :: mapgridlen - integer,dimension(MAXLEN) :: mapgrid - logical :: needext - end type gridtemplate - - type(gridtemplate),dimension(MAXTEMP) :: templates - - data templates(1)%template_num /0/ ! Lat/Lon - data templates(1)%mapgridlen /19/ - data templates(1)%needext /.false./ - data (templates(1)%mapgrid(j),j=1,19) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/ - - data templates(2)%template_num /1/ ! Rotated Lat/Lon - data templates(2)%mapgridlen /22/ - data templates(2)%needext /.false./ - data (templates(2)%mapgrid(j),j=1,22) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4/ - - data templates(3)%template_num /2/ ! Stretched Lat/Lon - data templates(3)%mapgridlen /22/ - data templates(3)%needext /.false./ - data (templates(3)%mapgrid(j),j=1,22) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,-4/ - - data templates(4)%template_num /3/ ! Stretched & Rotated Lat/Lon - data templates(4)%mapgridlen /25/ - data templates(4)%needext /.false./ - data (templates(4)%mapgrid(j),j=1,25) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4,-4,4,-4/ - - data templates(5)%template_num /10/ ! Mercator - data templates(5)%mapgridlen /19/ - data templates(5)%needext /.false./ - data (templates(5)%mapgrid(j),j=1,19) - & /1,1,4,1,4,1,4,4,4,-4,4,1,-4,-4,4,1,4,4,4/ - - data templates(6)%template_num /20/ ! Polar Stereographic - data templates(6)%mapgridlen /18/ - data templates(6)%needext /.false./ - data (templates(6)%mapgrid(j),j=1,18) - & /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1/ - - data templates(7)%template_num /30/ ! Lambert Conformal - data templates(7)%mapgridlen /22/ - data templates(7)%needext /.false./ - data (templates(7)%mapgrid(j),j=1,22) - & /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1,-4,-4,-4,4/ - - data templates(8)%template_num /40/ ! Gaussian Lat/Lon - data templates(8)%mapgridlen /19/ - data templates(8)%needext /.false./ - data (templates(8)%mapgrid(j),j=1,19) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/ - - data templates(9)%template_num /41/ ! Rotated Gaussian Lat/Lon - data templates(9)%mapgridlen /22/ - data templates(9)%needext /.false./ - data (templates(9)%mapgrid(j),j=1,22) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4/ - - data templates(10)%template_num /42/ ! Stretched Gaussian Lat/Lon - data templates(10)%mapgridlen /22/ - data templates(10)%needext /.false./ - data (templates(10)%mapgrid(j),j=1,22) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,-4/ - - data templates(11)%template_num /43/ ! Strtchd and Rot'd Gaus Lat/Lon - data templates(11)%mapgridlen /25/ - data templates(11)%needext /.false./ - data (templates(11)%mapgrid(j),j=1,25) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4,-4,4,-4/ - - data templates(12)%template_num /50/ ! Spherical Harmonic Coefficients - data templates(12)%mapgridlen /5/ - data templates(12)%needext /.false./ - data (templates(12)%mapgrid(j),j=1,5) /4,4,4,1,1/ - - data templates(13)%template_num /51/ ! Rotated Spherical Harmonic Coeff - data templates(13)%mapgridlen /8/ - data templates(13)%needext /.false./ - data (templates(13)%mapgrid(j),j=1,8) /4,4,4,1,1,-4,4,4/ - - data templates(14)%template_num /52/ ! Stretch Spherical Harmonic Coeff - data templates(14)%mapgridlen /8/ - data templates(14)%needext /.false./ - data (templates(14)%mapgrid(j),j=1,8) /4,4,4,1,1,-4,4,-4/ - - data templates(15)%template_num /53/ ! Strch and Rot Spher Harm Coeffs - data templates(15)%mapgridlen /11/ - data templates(15)%needext /.false./ - data (templates(15)%mapgrid(j),j=1,11) /4,4,4,1,1,-4,4,4,-4,4,-4/ - - data templates(16)%template_num /90/ ! Space view Perspective - data templates(16)%mapgridlen /21/ - data templates(16)%needext /.false./ - data (templates(16)%mapgrid(j),j=1,21) - & /1,1,4,1,4,1,4,4,4,-4,4,1,4,4,4,4,1,4,4,4,4/ - - data templates(17)%template_num /100/ ! Triangular grid (icosahedron) - data templates(17)%mapgridlen /11/ - data templates(17)%needext /.false./ - data (templates(17)%mapgrid(j),j=1,11) /1,1,2,1,-4,4,4,1,1,1,4/ - - data templates(18)%template_num /110/ ! Equatorial Azimuthal equidistant - data templates(18)%mapgridlen /16/ - data templates(18)%needext /.false./ - data (templates(18)%mapgrid(j),j=1,16) - & /1,1,4,1,4,1,4,4,4,-4,4,1,4,4,1,1/ - - data templates(19)%template_num /120/ ! Azimuth-range - data templates(19)%mapgridlen /7/ - data templates(19)%needext /.true./ - data (templates(19)%mapgrid(j),j=1,7) /4,4,-4,4,4,4,1/ - - data templates(20)%template_num /1000/ ! Cross Section Grid - data templates(20)%mapgridlen /20/ - data templates(20)%needext /.true./ - data (templates(20)%mapgrid(j),j=1,20) - & /1,1,4,1,4,1,4,4,4,4,-4,4,1,4,4,1,2,1,1,2/ - - data templates(21)%template_num /1100/ ! Hovmoller Diagram Grid - data templates(21)%mapgridlen /28/ - data templates(21)%needext /.false./ - data (templates(21)%mapgrid(j),j=1,28) - & /1,1,4,1,4,1,4,4,4,4,-4,4,1,-4,4,1,4,1,-4,1,1,-4,2,1,1,1,1,1/ - - data templates(22)%template_num /1200/ ! Time Section Grid - data templates(22)%mapgridlen /16/ - data templates(22)%needext /.true./ - data (templates(22)%mapgrid(j),j=1,16) - & /4,1,-4,1,1,-4,2,1,1,1,1,1,2,1,1,2/ - - data templates(23)%template_num /31/ ! Albers Equal Area - data templates(23)%mapgridlen /22/ - data templates(23)%needext /.false./ - data (templates(23)%mapgrid(j),j=1,22) - & /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1,-4,-4,-4,4/ - - data templates(24)%template_num /204/ ! Curilinear Orthogonal Grids - data templates(24)%mapgridlen /19/ - data templates(24)%needext /.false./ - data (templates(24)%mapgrid(j),j=1,19) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/ - - data templates(25)%template_num /32768/ ! Rotate Lat/Lon E-grid - data templates(25)%mapgridlen /19/ - data templates(25)%needext /.false./ - data (templates(25)%mapgrid(j),j=1,19) - & /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/ - - contains - - - integer function getgridindex(number) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getgridindex -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28 -! -! ABSTRACT: This function returns the index of specified Grid -! Definition Template 3.NN (NN=number) in array templates. -! -! PROGRAM HISTORY LOG: -! 2001-06-28 Gilbert -! -! USAGE: index=getgridindex(number) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Grid Definition -! Template 3.NN that is being requested. -! -! RETURNS: Index of GDT 3.NN in array templates, if template exists. -! = -1, otherwise. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number - - getgridindex=-1 - - do j=1,MAXTEMP - if (number.eq.templates(j)%template_num) then - getgridindex=j - return - endif - enddo - - end function - - - subroutine getgridtemplate(number,nummap,map,needext,iret) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getgridtemplate -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09 -! -! ABSTRACT: This subroutine returns grid template information for a -! specified Grid Definition Template 3.NN. -! The number of entries in the template is returned along with a map -! of the number of octets occupied by each entry. Also, a flag is -! returned to indicate whether the template would need to be extended. -! -! PROGRAM HISTORY LOG: -! 2000-05-09 Gilbert -! -! USAGE: CALL getgridtemplate(number,nummap,map,needext,iret) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Grid Definition -! Template 3.NN that is being requested. -! -! OUTPUT ARGUMENT LIST: -! nummap - Number of entries in the Template -! map() - An array containing the number of octets that each -! template entry occupies when packed up into the GDS. -! needext - Logical variable indicating whether the Grid Defintion -! Template has to be extended. -! ierr - Error return code. -! 0 = no error -! 1 = Undefine Grid Template number. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number - integer,intent(out) :: nummap,map(*),iret - logical,intent(out) :: needext - - iret=0 - - index=getgridindex(number) - - if (index.ne.-1) then - nummap=templates(index)%mapgridlen - needext=templates(index)%needext - map(1:nummap)=templates(index)%mapgrid(1:nummap) - else - nummap=0 - needext=.false. - print *,'getgridtemplate: Grid Template ',number, - & ' not defined.' - iret=1 - endif - - end subroutine - - - subroutine extgridtemplate(number,list,nummap,map) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: extgridtemplate -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09 -! -! ABSTRACT: This subroutine generates the remaining octet map for a -! given Grid Definition Template, if required. Some Templates can -! vary depending on data values given in an earlier part of the -! Template, and it is necessary to know some of the earlier entry -! values to generate the full octet map of the Template. -! -! PROGRAM HISTORY LOG: -! 2000-05-09 Gilbert -! -! USAGE: CALL extgridtemplate(number,list,nummap,map) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Grid Definition -! Template 3.NN that is being requested. -! list() - The list of values for each entry in -! the Grid Definition Template. -! -! OUTPUT ARGUMENT LIST: -! nummap - Number of entries in the Template -! map() - An array containing the number of octets that each -! template entry occupies when packed up into the GDS. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number,list(*) - integer,intent(out) :: nummap,map(*) - - index=getgridindex(number) - if (index.eq.-1) return - - if ( .not. templates(index)%needext ) return - nummap=templates(index)%mapgridlen - map(1:nummap)=templates(index)%mapgrid(1:nummap) - - if ( number.eq.120 ) then - N=list(2) - do i=1,N - map(nummap+1)=2 - map(nummap+2)=-2 - nummap=nummap+2 - enddo - elseif ( number.eq.1000 ) then - N=list(20) - do i=1,N - map(nummap+1)=4 - nummap=nummap+1 - enddo - elseif ( number.eq.1200 ) then - N=list(16) - do i=1,N - map(nummap+1)=4 - nummap=nummap+1 - enddo - endif - - end subroutine - - integer function getgdtlen(number) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getgdtlen -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-05-11 -! -! ABSTRACT: This function returns the initial length (number of entries) in -! the "static" part of specified Grid Definition Template 3.number. -! -! PROGRAM HISTORY LOG: -! 2004-05-11 Gilbert -! -! USAGE: CALL getgdtlen(number) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Grid Definition -! Template 3.NN that is being requested. -! -! RETURNS: Number of entries in the "static" part of GDT 3.number -! OR returns 0, if requested template is not found. -! -! REMARKS: If user needs the full length of a specific template that -! contains additional entries based on values set in the "static" part -! of the GDT, subroutine extgridtemplate can be used. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number - - getgdtlen=0 - - index=getgridindex(number) - - if (index.ne.-1) then - getgdtlen=templates(index)%mapgridlen - endif - - end function - - - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gridtemplates.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gridtemplates.mod deleted file mode 100644 index a83767d620..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/gridtemplates.mod +++ /dev/null @@ -1,71 +0,0 @@ -GFORTRAN module created from gridtemplates.f on Mon Nov 16 16:42:52 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'extgridtemplate' 'gridtemplates' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL SUBROUTINE) (UNKNOWN 0 ()) 3 0 (4 5 6 7) () 0 () ()) -8 'getgridindex' 'gridtemplates' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL FUNCTION) (INTEGER 4 ()) 9 0 (10) () 8 () ()) -11 'gridtemplates' 'gridtemplates' 1 ((MODULE UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 () ()) -12 'gridtemplate' 'gridtemplates' 1 ((DERIVED UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 ((13 'template_num' ( -INTEGER 4 ()) () 0 0 ()) (14 'mapgridlen' (INTEGER 4 ()) () 0 0 ()) (15 -'mapgrid' (INTEGER 4 ()) (1 EXPLICIT (CONSTANT (INTEGER 4 ()) 0 '1') ( -CONSTANT (INTEGER 4 ()) 0 '200')) 1 0 ()) (16 'needext' (LOGICAL 4 ()) () -0 0 ())) PUBLIC ()) -17 'maxlen' 'gridtemplates' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '200') () 0 () -()) -18 'templates' 'gridtemplates' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN DIMENSION DATA) (DERIVED 12 ()) 0 0 () (1 EXPLICIT (CONSTANT ( -INTEGER 4 ()) 0 '1') (CONSTANT (INTEGER 4 ()) 0 '25')) 0 () ()) -19 'maxtemp' 'gridtemplates' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '25') () 0 () -()) -20 'j' 'gridtemplates' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(INTEGER 4 ()) 0 0 () () 0 () ()) -21 'getgridtemplate' 'gridtemplates' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL SUBROUTINE) (UNKNOWN 0 ()) 22 0 (23 24 25 26 27) () 0 () -()) -28 'getgdtlen' 'gridtemplates' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL FUNCTION) (INTEGER 4 ()) 29 0 (30) () 28 () ()) -25 'map' '' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -24 'nummap' '' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 -()) 0 0 () () 0 () ()) -26 'needext' '' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (LOGICAL 4 -()) 0 0 () () 0 () ()) -23 'number' '' 22 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -10 'number' '' 9 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -4 'number' '' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -6 'nummap' '' 3 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -7 'map' '' 3 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -5 'list' '' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -27 'iret' '' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -30 'number' '' 29 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -) - -('getgdtlen' 0 28 'extgridtemplate' 0 2 'getgridtemplate' 0 21 -'getgridindex' 0 8 'j' 0 20 'gridtemplate' 0 12 'gridtemplates' 0 11 -'maxtemp' 0 19 'maxlen' 0 17 'templates' 0 18) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/ixgb2.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/ixgb2.f deleted file mode 100755 index ec6ab63b3d..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/ixgb2.f +++ /dev/null @@ -1,206 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: IXGB2 MAKE INDEX RECORDS FOR FIELDS IN A GRIB2 MESSAGE -C PRGMMR: GILBERT ORG: W/NP11 DATE: 2001-12-10 -C -C ABSTRACT: THIS SUBPROGRAM GENERATES AN INDEX RECORD FOR EACH FIELD IN A -C GRIB2 MESSAGE. THE INDEX RECORDS ARE WRITTEN TO INDEX BUFFER -C POINTED TO BY CBUF. -C -C EACH INDEX RECORD HAS THE FOLLOWING FORM: -C BYTE 001 - 004: LENGTH OF INDEX RECORD -C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE) -C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE. -C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS -C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS -C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS -C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION -C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE -C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 ) -C BYTE 042 - 042: MESSAGE DISCIPLINE -C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE -C BYTE 045 - II: IDENTIFICATION SECTION (IDS) -C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS) -C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS) -C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS) -C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS) -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 -C 2001-12-10 GILBERT MODIFIED FROM IXGB TO CREATE GRIB2 INDEXES -C 2002-01-31 GILBERT ADDED IDENTIFICATION SECTION TO INDEX RECORD -C -C USAGE: CALL IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE -C LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE -C LGRIB INTEGER NUMBER OF BYTES IN GRIB MESSAGE -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS. -C USERS SHOULD FREE MEMORY THAT CBUF POINTS TO -C USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED. -C NUMFLD INTEGER NUMBER OF INDEX RECORDS CREATED. -C = 0, IF PROBLEMS -C MLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS -C IRET INTEGER RETURN CODE -C =0, ALL OK -C =1, NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER -C =2, I/O ERROR IN READ -C =3, GRIB MESSAGE IS NOT EDITION 2 -C =4, NOT ENOUGH MEMORY TO ALLOCATE EXTENT TO INDEX BUFFER -C =5, UNIDENTIFIED GRIB SECTION ENCOUNTERED...PROBLEM -C SOMEWHERE. -C -C SUBPROGRAMS CALLED: -C GBYTE GET INTEGER DATA FROM BYTES -C SBYTE STORE INTEGER DATA IN BYTES -C BAREAD BYTE-ADDRESSABLE READ -C REALLOC RE-ALLOCATES MORE MEMORY -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE RE_ALLOC ! NEEDED FOR SUBROUTINE REALLOC - CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF - PARAMETER(LINMAX=5000,INIT=50000,NEXT=10000) - PARAMETER(IXSKP=4,IXLUS=8,IXSGD=12,IXSPD=16,IXSDR=20,IXSBM=24, - & IXDS=28,IXLEN=36,IXFLD=42,IXIDS=44) - PARAMETER(MXSKP=4,MXLUS=4,MXSGD=4,MXSPD=4,MXSDR=4,MXSBM=4, - & MXDS=4,MXLEN=4,MXFLD=2,MXBMS=6) - CHARACTER CBREAD(LINMAX),CINDEX(LINMAX) - CHARACTER CVER,CDISC - CHARACTER CIDS(LINMAX),CGDS(LINMAX),CBMS(6) - CHARACTER(LEN=4) :: CTEMP - INTEGER LOCLUS,LOCGDS,LENGDS,LOCBMS -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - LOCLUS=0 - IRET=0 - MLEN=0 - NUMFLD=0 - IF (ASSOCIATED(CBUF)) NULLIFY(CBUF) - MBUF=INIT - ALLOCATE(CBUF(MBUF),STAT=ISTAT) ! ALLOCATE INITIAL SPACE FOR CBUF - IF (ISTAT.NE.0) THEN - IRET=1 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ SECTIONS 0 AND 1 FOR VERSIN NUMBER AND DISCIPLINE - IBREAD=MIN(LGRIB,LINMAX) - CALL BAREAD(LUGB,LSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) THEN - IRET=2 - RETURN - ENDIF - IF(CBREAD(8).NE.CHAR(2)) THEN ! NOT GRIB EDITION 2 - IRET=3 - RETURN - ENDIF - CVER=CBREAD(8) - CDISC=CBREAD(7) - CALL GBYTE(CBREAD,LENSEC1,16*8,4*8) - LENSEC1=MIN(LENSEC1,IBREAD) - CIDS(1:LENSEC1)=CBREAD(17:16+LENSEC1) - IBSKIP=LSKIP+16+LENSEC1 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C LOOP THROUGH REMAINING SECTIONS CREATING AN INDEX FOR EACH FIELD - IBREAD=MAX(5,MXBMS) - DO - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - CTEMP=CBREAD(1)//CBREAD(2)//CBREAD(3)//CBREAD(4) - IF (CTEMP.EQ.'7777') RETURN ! END OF MESSAGE FOUND - IF(LBREAD.NE.IBREAD) THEN - IRET=2 - RETURN - ENDIF - CALL GBYTE(CBREAD,LENSEC,0*8,4*8) - CALL GBYTE(CBREAD,NUMSEC,4*8,1*8) - - IF (NUMSEC.EQ.2) THEN ! SAVE LOCAL USE LOCATION - LOCLUS=IBSKIP-LSKIP - ELSEIF (NUMSEC.EQ.3) THEN ! SAVE GDS INFO - LENGDS=LENSEC - CGDS=CHAR(0) - CALL BAREAD(LUGB,IBSKIP,LENGDS,LBREAD,CGDS) - IF(LBREAD.NE.LENGDS) THEN - IRET=2 - RETURN - ENDIF - LOCGDS=IBSKIP-LSKIP - ELSEIF (NUMSEC.EQ.4) THEN ! FOUND PDS - CINDEX=CHAR(0) - CALL SBYTE(CINDEX,LSKIP,8*IXSKP,8*MXSKP) ! BYTES TO SKIP - CALL SBYTE(CINDEX,LOCLUS,8*IXLUS,8*MXLUS) ! LOCATION OF LOCAL USE - CALL SBYTE(CINDEX,LOCGDS,8*IXSGD,8*MXSGD) ! LOCATION OF GDS - CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSPD,8*MXSPD) ! LOCATION OF PDS - CALL SBYTE(CINDEX,LGRIB,8*IXLEN,8*MXLEN) ! LEN OF GRIB2 - CINDEX(41)=CVER - CINDEX(42)=CDISC - CALL SBYTE(CINDEX,NUMFLD+1,8*IXFLD,8*MXFLD) ! FIELD NUM - CINDEX(IXIDS+1:IXIDS+LENSEC1)=CIDS(1:LENSEC1) - LINDEX=IXIDS+LENSEC1 - CINDEX(LINDEX+1:LINDEX+LENGDS)=CGDS(1:LENGDS) - LINDEX=LINDEX+LENGDS - ILNPDS=LENSEC - CALL BAREAD(LUGB,IBSKIP,ILNPDS,LBREAD,CINDEX(LINDEX+1)) - IF(LBREAD.NE.ILNPDS) THEN - IRET=2 - RETURN - ENDIF - ! CINDEX(LINDEX+1:LINDEX+ILNPDS)=CBREAD(1:ILNPDS) - LINDEX=LINDEX+ILNPDS - ELSEIF (NUMSEC.EQ.5) THEN ! FOUND DRS - CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSDR,8*MXSDR) ! LOCATION OF DRS - ILNDRS=LENSEC - CALL BAREAD(LUGB,IBSKIP,ILNDRS,LBREAD,CINDEX(LINDEX+1)) - IF(LBREAD.NE.ILNDRS) THEN - IRET=2 - RETURN - ENDIF - ! CINDEX(LINDEX+1:LINDEX+ILNDRS)=CBREAD(1:ILNDRS) - LINDEX=LINDEX+ILNDRS - ELSEIF (NUMSEC.EQ.6) THEN ! FOUND BMS - INDBMP=MOVA2I(CBREAD(6)) - IF ( INDBMP.LT.254 ) THEN - LOCBMS=IBSKIP-LSKIP - CALL SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM) ! LOC. OF BMS - ELSEIF ( INDBMP.EQ.254 ) THEN - CALL SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM) ! LOC. OF BMS - ELSEIF ( INDBMP.EQ.255 ) THEN - CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSBM,8*MXSBM) ! LOC. OF BMS - ENDIF - CINDEX(LINDEX+1:LINDEX+MXBMS)=CBREAD(1:MXBMS) - LINDEX=LINDEX+MXBMS - CALL SBYTE(CINDEX,LINDEX,0,8*4) ! NUM BYTES IN INDEX RECORD - ELSEIF (NUMSEC.EQ.7) THEN ! FOUND DATA SECTION - CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXDS,8*MXDS) ! LOC. OF DATA SEC. - NUMFLD=NUMFLD+1 - IF ((LINDEX+MLEN).GT.MBUF) THEN ! ALLOCATE MORE SPACE IF - ! NECESSARY - NEWSIZE=MAX(MBUF+NEXT,MBUF+LINDEX) - CALL REALLOC(CBUF,MLEN,NEWSIZE,ISTAT) - IF ( ISTAT .NE. 0 ) THEN - NUMFLD=NUMFLD-1 - IRET=4 - RETURN - ENDIF - MBUF=NEWSIZE - ENDIF - CBUF(MLEN+1:MLEN+LINDEX)=CINDEX(1:LINDEX) - MLEN=MLEN+LINDEX - ELSE ! UNRECOGNIZED SECTION - IRET=5 - RETURN - ENDIF - IBSKIP=IBSKIP+LENSEC - ENDDO - -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/jpcpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/jpcpack.f deleted file mode 100755 index b90f5acc0b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/jpcpack.f +++ /dev/null @@ -1,178 +0,0 @@ - subroutine jpcpack(fld,width,height,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: jpcpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-17 -! -! ABSTRACT: This subroutine packs up a data field into a JPEG2000 code stream. -! After the data field is scaled, and the reference value is subtracted out, -! it is treated as a grayscale image and passed to a JPEG2000 encoder. -! It also fills in GRIB2 Data Representation Template 5.40 or 5.40000 with the -! appropriate values. -! -! PROGRAM HISTORY LOG: -! 2002-12-17 Gilbert -! 2004-07-19 Gilbert - Added check on whether the jpeg2000 encoding was -! successful. If not, try again with different encoder -! options. -! -! USAGE: CALL jpcpack(fld,width,height,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the data values to pack -! width - number of points in the x direction -! height - number of points in the y direction -! idrstmpl - Contains the array of values for Data Representation -! Template 5.40 or 5.40000 -! (1) = Reference value - ignored on input -! (2) = Binary Scale Factor -! (3) = Decimal Scale Factor -! (4) = number of bits for each data value - ignored on input -! (5) = Original field type - currently ignored on input -! Data values assumed to be reals. -! (6) = 0 - use lossless compression -! = 1 - use lossy compression -! (7) = Desired compression ratio, if idrstmpl(6)=1. -! Set to 255, if idrstmpl(6)=0. -! lcpack - size of array cpack(). -! -! OUTPUT ARGUMENT LIST: -! idrstmpl - Contains the array of values for Data Representation -! Template 5.0 -! (1) = Reference value - set by jpcpack routine. -! (2) = Binary Scale Factor - unchanged from input -! (3) = Decimal Scale Factor - unchanged from input -! (4) = Number of bits containing each grayscale pixel value -! (5) = Original field type - currently set = 0 on output. -! Data values assumed to be reals. -! (6) = 0 - use lossless compression -! = 1 - use lossy compression -! (7) = Desired compression ratio, if idrstmpl(6)=1 -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field in cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,intent(in) :: width,height - real,intent(in) :: fld(width*height) - character(len=1),intent(out) :: cpack(*) - integer,intent(inout) :: idrstmpl(*) - integer,intent(inout) :: lcpack - - real(4) :: ref,rmin4 - real(8) :: rmin,rmax - integer(4) :: iref - integer :: ifld(width*height),retry - integer,parameter :: zero=0 - integer :: enc_jpeg2000 - character(len=1),allocatable :: ctemp(:) - - ndpts=width*height - bscale=2.0**real(-idrstmpl(2)) - dscale=10.0**real(idrstmpl(3)) -! -! Find max and min values in the data -! - rmax=fld(1) - rmin=fld(1) - do j=2,ndpts - if (fld(j).gt.rmax) rmax=fld(j) - if (fld(j).lt.rmin) rmin=fld(j) - enddo - if (idrstmpl(2).eq.0) then - maxdif=nint(rmax*dscale)-nint(rmin*dscale) - else - maxdif=nint((rmax-rmin)*dscale*bscale) - endif -! -! If max and min values are not equal, pack up field. -! If they are equal, we have a constant field, and the reference -! value (rmin) is the value for each point in the field and -! set nbits to 0. -! - if (rmin.ne.rmax .AND. maxdif.ne.0) then - ! - ! Determine which algorithm to use based on user-supplied - ! binary scale factor and number of bits. - ! - if (idrstmpl(2).eq.0) then - ! - ! No binary scaling and calculate minimum number of - ! bits in which the data will fit. - ! - imin=nint(rmin*dscale) - imax=nint(rmax*dscale) - maxdif=imax-imin - temp=alog(real(maxdif+1))/alog(2.0) - nbits=ceiling(temp) - rmin=real(imin) - ! scale data - do j=1,ndpts - ifld(j)=nint(fld(j)*dscale)-imin - enddo - else - ! - ! Use binary scaling factor and calculate minimum number of - ! bits in which the data will fit. - ! - rmin=rmin*dscale - rmax=rmax*dscale - maxdif=nint((rmax-rmin)*bscale) - temp=alog(real(maxdif+1))/alog(2.0) - nbits=ceiling(temp) - ! scale data - do j=1,ndpts - ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale) - enddo - endif - ! - ! Pack data into full octets, then do JPEG2000 encode. - ! and calculate the length of the packed data in bytes - ! - retry=0 - nbytes=(nbits+7)/8 - nsize=lcpack ! needed for input to enc_jpeg2000 - allocate(ctemp(nbytes*ndpts)) - call sbytes(ctemp,ifld,0,nbytes*8,0,ndpts) - lcpack=enc_jpeg2000(ctemp,width,height,nbits,idrstmpl(6), - & idrstmpl(7),retry,cpack,nsize) - if (lcpack.le.0) then - print *,'jpcpack: ERROR Packing JPC=',lcpack - if (lcpack.eq.-3) then - retry=1 - print *,'jpcpack: Retrying....' - lcpack=enc_jpeg2000(ctemp,width,height,nbits,idrstmpl(6), - & idrstmpl(7),retry,cpack,nsize) - if (lcpack.le.0) then - print *,'jpcpack: Retry Failed.' - else - print *,'jpcpack: Retry Successful.' - endif - endif - endif - deallocate(ctemp) - - else - nbits=0 - lcpack=0 - endif - -! -! Fill in ref value and number of bits in Template 5.0 -! - rmin4 = rmin - call mkieee(rmin4,ref,1) ! ensure reference value is IEEE format -! call gbyte(ref,idrstmpl(1),0,32) - iref=transfer(ref,iref) - idrstmpl(1)=iref - idrstmpl(4)=nbits - idrstmpl(5)=0 ! original data were reals - if (idrstmpl(6).eq.0) idrstmpl(7)=255 ! lossy not used - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/jpcunpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/jpcunpack.f deleted file mode 100755 index 88d2beebb6..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/jpcunpack.f +++ /dev/null @@ -1,66 +0,0 @@ - subroutine jpcunpack(cpack,len,idrstmpl,ndpts,fld) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: jpcunpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-17 -! -! ABSTRACT: This subroutine unpacks a data field that was packed into a -! JPEG2000 code stream -! using info from the GRIB2 Data Representation Template 5.40 or 5.40000. -! -! PROGRAM HISTORY LOG: -! 2002-12-17 Gilbert -! -! USAGE: CALL jpcunpack(cpack,len,idrstmpl,ndpts,fld) -! INPUT ARGUMENT LIST: -! cpack - The packed data field (character*1 array) -! len - length of packed field cpack(). -! idrstmpl - Contains the array of values for Data Representation -! Template 5.40 or 5.40000 -! ndpts - The number of data values to unpack -! -! OUTPUT ARGUMENT LIST: -! fld() - Contains the unpacked data values -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cpack(len) - integer,intent(in) :: ndpts,len - integer,intent(in) :: idrstmpl(*) - real,intent(out) :: fld(ndpts) - - integer :: ifld(ndpts) - integer(4) :: ieee - real :: ref,bscale,dscale - integer :: dec_jpeg2000 - - ieee = idrstmpl(1) - call rdieee(ieee,ref,1) - bscale = 2.0**real(idrstmpl(2)) - dscale = 10.0**real(-idrstmpl(3)) - nbits = idrstmpl(4) -! -! if nbits equals 0, we have a constant field where the reference value -! is the data value at each gridpoint -! - if (nbits.ne.0) then -! call gbytes(cpack,ifld,0,nbits,0,ndpts) - iret=dec_jpeg2000(cpack,len,ifld) - do j=1,ndpts - fld(j)=((real(ifld(j))*bscale)+ref)*dscale - enddo - else - do j=1,ndpts - fld(j)=ref - enddo - endif - - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/makefile b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/makefile deleted file mode 100755 index f81b2123bb..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/makefile +++ /dev/null @@ -1,133 +0,0 @@ -SHELL=/bin/sh - -# Make sure one of the following options appears in your CFLAGS -# variable to indicate which system you are on. Used to call -# "C" routines from Fortran. -# -DLINUX, -DLINUXG95, -DSGI, -DHP, -DCRAY90, -DAIX, -DLINUXF90, -DVPP5000 - -# If you want to enable support for PNG or JPEG2000 encoding/decoding, -# you must specify -DUSE_PNG and/or -DUSE_JPEG2000 in the FDEFS variable -# for the Fortran pre-processor -# -DUSE_PNG requires libpng.a and libz.a -# ( and png.h pngconf.h zconf.h zlib.h include files). -# -DUSE_JPEG2000 requires libjasper.a -# ( and all the jasper/*.h include files). -# -# In addition, INCDIR must include all directories where the above -# mentioned include files can be found. -FDEFS=-DUSE_PNG -DUSE_JPEG2000 -INCDIR=-I/home/brockwoo/workspace/ncepLib/org.ncep.grib/include - -LIB=libg2.a - -#-------------------------------------- -# The following was used for XLF on AIX -#DEFS=-DAIX -DHAVE_SYS_TYPES_H=1 -#FC=xlf -#CC=xlc -#CPP=/usr/ccs/lib/cpp -P -#MODDIR=../g2mod -#FFLAGS=-O3 -g -qnosave -qarch=auto -qmoddir=$(MODDIR) -I $(MODDIR) -#CFLAGS=-O3 -q64 -g -qcpluscmt -qarch=auto $(DEFS) $(INCDIR) -#ARFLAGS=-X64 -#-------------------------------------- -# The following was used for G95 on LINUX -# -DEFS=-DLINUX -FC=gfortran -CC=gcc -CPP=cpp -P -C -MODDIR=. -FFLAGS=-O2 -g -I $(MODDIR) -# -#----- used with 32-bit machine --- -# -CFLAGS=-O3 $(DEFS) $(INCDIR) -# -#----- used with 64-bit machine --- -# -# CFLAGS=-O3 $(DEFS) $(INCDIR) -D__64BIT__ -# -ARFLAGS= -#-------------------------------------- - -.SUFFIXES: .a .f .F .c - -$(LIB): $(LIB)(gridtemplates.o) \ - $(LIB)(pdstemplates.o) \ - $(LIB)(drstemplates.o) \ - $(LIB)(gribmod.o) \ - $(LIB)(realloc.o) \ - $(LIB)(addfield.o) \ - $(LIB)(addgrid.o) \ - $(LIB)(addlocal.o) \ - $(LIB)(getfield.o) \ - $(LIB)(gb_info.o) \ - $(LIB)(gf_getfld.o) \ - $(LIB)(gf_free.o) \ - $(LIB)(gf_unpack1.o) \ - $(LIB)(gf_unpack2.o) \ - $(LIB)(gf_unpack3.o) \ - $(LIB)(gf_unpack4.o) \ - $(LIB)(gf_unpack5.o) \ - $(LIB)(gf_unpack6.o) \ - $(LIB)(gf_unpack7.o) \ - $(LIB)(gettemplates.o) \ - $(LIB)(getlocal.o) \ - $(LIB)(getdim.o) \ - $(LIB)(getpoly.o) \ - $(LIB)(gribcreate.o) \ - $(LIB)(gribend.o) \ - $(LIB)(gribinfo.o) \ - $(LIB)(mkieee.o) \ - $(LIB)(rdieee.o) \ - $(LIB)(simpack.o) \ - $(LIB)(simunpack.o) \ - $(LIB)(cmplxpack.o) \ - $(LIB)(compack.o) \ - $(LIB)(misspack.o) \ - $(LIB)(pack_gp.o) \ - $(LIB)(reduce.o) \ - $(LIB)(comunpack.o) \ - $(LIB)(specpack.o) \ - $(LIB)(specunpack.o) \ - $(LIB)(jpcpack.o) \ - $(LIB)(jpcunpack.o) \ - $(LIB)(enc_jpeg2000.o) \ - $(LIB)(dec_jpeg2000.o) \ - $(LIB)(pngpack.o) \ - $(LIB)(pngunpack.o) \ - $(LIB)(enc_png.o) \ - $(LIB)(dec_png.o) \ - $(LIB)(mova2i.o) \ - $(LIB)(gbytesc.o) \ - $(LIB)(skgb.o) \ - $(LIB)(ixgb2.o) \ - $(LIB)(getg2i.o) \ - $(LIB)(getg2ir.o) \ - $(LIB)(getgb2s.o) \ - $(LIB)(getgb2r.o) \ - $(LIB)(getgb2l.o) \ - $(LIB)(getgb2.o) \ - $(LIB)(getgb2p.o) \ - $(LIB)(getgb2rp.o) \ - $(LIB)(putgb2.o) \ - $(LIB)(g2grids.o) \ - $(LIB)(params.o) \ - $(LIB)(params_ecmwf.o) \ - $(LIB)(getidx.o) \ - $(LIB)(gdt2gds.o) - -.F.f: - $(CPP) $(FDEFS) $*.F $*.f - -.f.a: - $(FC) -c $(FFLAGS) $< - ar $(ARFLAGS) -ruc $@ $*.o - rm -f $*.o - -.c.a: - $(CC) -c $(CFLAGS) $< - ar $(ARFLAGS) -ruc $@ $*.o - rm -f $*.o - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/misspack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/misspack.f deleted file mode 100755 index 1c9e4450c5..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/misspack.f +++ /dev/null @@ -1,499 +0,0 @@ - subroutine misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: misspack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21 -! -! ABSTRACT: This subroutine packs up a data field using a complex -! packing algorithm as defined in the GRIB2 documention. It -! supports GRIB2 complex packing templates with or without -! spatial differences (i.e. DRTs 5.2 and 5.3). -! It also fills in GRIB2 Data Representation Template 5.2 or 5.3 -! with the appropriate values. -! This version assumes that Missing Value Management is being used and that -! 1 or 2 missing values appear in the data. -! -! PROGRAM HISTORY LOG: -! 2000-06-21 Gilbert -! 2004-12-29 Gilbert - Corrected bug when encoding secondary missing values. -! -! USAGE: CALL misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the data values to pack -! ndpts - The number of data values in array fld() -! idrsnum - Data Representation Template number 5.N -! Must equal 2 or 3. -! idrstmpl - Contains the array of values for Data Representation -! Template 5.2 or 5.3 -! (1) = Reference value - ignored on input -! (2) = Binary Scale Factor -! (3) = Decimal Scale Factor -! . -! . -! (7) = Missing value management -! (8) = Primary missing value -! (9) = Secondary missing value -! . -! . -! (17) = Order of Spatial Differencing ( 1 or 2 ) -! . -! . -! -! OUTPUT ARGUMENT LIST: -! idrstmpl - Contains the array of values for Data Representation -! Template 5.3 -! (1) = Reference value - set by misspack routine. -! (2) = Binary Scale Factor - unchanged from input -! (3) = Decimal Scale Factor - unchanged from input -! . -! . -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,intent(in) :: ndpts,idrsnum - real,intent(in) :: fld(ndpts) - character(len=1),intent(out) :: cpack(*) - integer,intent(inout) :: idrstmpl(*) - integer,intent(out) :: lcpack - - real(4) :: ref - integer(4) :: iref - integer,allocatable :: ifld(:),ifldmiss(:),jfld(:) - integer,allocatable :: jmin(:),jmax(:),lbit(:) - integer,parameter :: zero=0 - integer,allocatable :: gref(:),gwidth(:),glen(:) - integer :: glength,grpwidth - logical :: simple_alg = .false. - - alog2=alog(2.0) - bscale=2.0**real(-idrstmpl(2)) - dscale=10.0**real(idrstmpl(3)) - missopt=idrstmpl(7) - if ( missopt.ne.1 .AND. missopt.ne.2 ) then - print *,'misspack: Unrecognized option.' - lcpack=-1 - return - else ! Get missing values - call rdieee(idrstmpl(8),rmissp,1) - if (missopt.eq.2) call rdieee(idrstmpl(9),rmisss,1) - endif -! -! Find min value of non-missing values in the data, -! AND set up missing value mapping of the field. -! - allocate(ifldmiss(ndpts)) - rmin=huge(rmin) - if ( missopt .eq. 1 ) then ! Primary missing value only - do j=1,ndpts - if (fld(j).eq.rmissp) then - ifldmiss(j)=1 - else - ifldmiss(j)=0 - if (fld(j).lt.rmin) rmin=fld(j) - endif - enddo - endif - if ( missopt .eq. 2 ) then ! Primary and secondary missing values - do j=1,ndpts - if (fld(j).eq.rmissp) then - ifldmiss(j)=1 - elseif (fld(j).eq.rmisss) then - ifldmiss(j)=2 - else - ifldmiss(j)=0 - if (fld(j).lt.rmin) rmin=fld(j) - endif - enddo - endif -! -! Allocate work arrays: -! Note: -ifldmiss(j),j=1,ndpts is a map of original field indicating -! which of the original data values -! are primary missing (1), sencondary missing (2) or non-missing (0). -! -jfld(j),j=1,nonmiss is a subarray of just the non-missing values from -! the original field. -! - !if (rmin.ne.rmax) then - iofst=0 - allocate(ifld(ndpts)) - allocate(jfld(ndpts)) - allocate(gref(ndpts)) - allocate(gwidth(ndpts)) - allocate(glen(ndpts)) - ! - ! Scale original data - ! - nonmiss=0 - if (idrstmpl(2).eq.0) then ! No binary scaling - imin=nint(rmin*dscale) - !imax=nint(rmax*dscale) - rmin=real(imin) - do j=1,ndpts - if (ifldmiss(j).eq.0) then - nonmiss=nonmiss+1 - jfld(nonmiss)=nint(fld(j)*dscale)-imin - endif - enddo - else ! Use binary scaling factor - rmin=rmin*dscale - !rmax=rmax*dscale - do j=1,ndpts - if (ifldmiss(j).eq.0) then - nonmiss=nonmiss+1 - jfld(nonmiss)=nint(((fld(j)*dscale)-rmin)*bscale) - endif - enddo - endif - ! - ! Calculate Spatial differences, if using DRS Template 5.3 - ! - if (idrsnum.eq.3) then ! spatial differences - if (idrstmpl(17).ne.1.and.idrstmpl(17).ne.2) idrstmpl(17)=2 - if (idrstmpl(17).eq.1) then ! first order - ival1=jfld(1) - do j=nonmiss,2,-1 - jfld(j)=jfld(j)-jfld(j-1) - enddo - jfld(1)=0 - elseif (idrstmpl(17).eq.2) then ! second order - ival1=jfld(1) - ival2=jfld(2) - do j=nonmiss,3,-1 - jfld(j)=jfld(j)-(2*jfld(j-1))+jfld(j-2) - enddo - jfld(1)=0 - jfld(2)=0 - endif - ! - ! subtract min value from spatial diff field - ! - isd=idrstmpl(17)+1 - minsd=minval(jfld(isd:nonmiss)) - do j=isd,nonmiss - jfld(j)=jfld(j)-minsd - enddo - ! - ! find num of bits need to store minsd and add 1 extra bit - ! to indicate sign - ! - temp=alog(real(abs(minsd)+1))/alog2 - nbitsd=ceiling(temp)+1 - ! - ! find num of bits need to store ifld(1) ( and ifld(2) - ! if using 2nd order differencing ) - ! - maxorig=ival1 - if (idrstmpl(17).eq.2.and.ival2.gt.ival1) maxorig=ival2 - temp=alog(real(maxorig+1))/alog2 - nbitorig=ceiling(temp)+1 - if (nbitorig.gt.nbitsd) nbitsd=nbitorig - ! increase number of bits to even multiple of 8 ( octet ) - if (mod(nbitsd,8).ne.0) nbitsd=nbitsd+(8-mod(nbitsd,8)) - ! - ! Store extra spatial differencing info into the packed - ! data section. - ! - if (nbitsd.ne.0) then - ! pack first original value - if (ival1.ge.0) then - call sbyte(cpack,ival1,iofst,nbitsd) - iofst=iofst+nbitsd - else - call sbyte(cpack,1,iofst,1) - iofst=iofst+1 - call sbyte(cpack,iabs(ival1),iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - endif - if (idrstmpl(17).eq.2) then - ! pack second original value - if (ival2.ge.0) then - call sbyte(cpack,ival2,iofst,nbitsd) - iofst=iofst+nbitsd - else - call sbyte(cpack,1,iofst,1) - iofst=iofst+1 - call sbyte(cpack,iabs(ival2),iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - endif - endif - ! pack overall min of spatial differences - if (minsd.ge.0) then - call sbyte(cpack,minsd,iofst,nbitsd) - iofst=iofst+nbitsd - else - call sbyte(cpack,1,iofst,1) - iofst=iofst+1 - call sbyte(cpack,iabs(minsd),iofst,nbitsd-1) - iofst=iofst+nbitsd-1 - endif - endif - !print *,'SDp ',ival1,ival2,minsd,nbitsd - endif ! end of spatial diff section - ! - ! Expand non-missing data values to original grid. - ! - miss1=minval(jfld(1:nonmiss))-1 - miss2=miss1-1 - n=0 - do j=1,ndpts - if ( ifldmiss(j).eq.0 ) then - n=n+1 - ifld(j)=jfld(n) - elseif ( ifldmiss(j).eq.1 ) then - ifld(j)=miss1 - elseif ( ifldmiss(j).eq.2 ) then - ifld(j)=miss2 - endif - enddo - ! - ! Determine Groups to be used. - ! - if ( simple_alg ) then - ! set group length to 10 : calculate number of groups - ! and length of last group - ngroups=ndpts/10 - glen(1:ngroups)=10 - itemp=mod(ndpts,10) - if (itemp.ne.0) then - ngroups=ngroups+1 - glen(ngroups)=itemp - endif - else - ! Use Dr. Glahn's algorithm for determining grouping. - ! - kfildo=6 - minpk=10 - inc=1 - maxgrps=(ndpts/minpk)+1 - allocate(jmin(maxgrps)) - allocate(jmax(maxgrps)) - allocate(lbit(maxgrps)) - call pack_gp(kfildo,ifld,ndpts,missopt,minpk,inc,miss1,miss2, - & jmin,jmax,lbit,glen,maxgrps,ngroups,ibit,jbit, - & kbit,novref,lbitref,ier) - !print *,'SAGier = ',ier,ibit,jbit,kbit,novref,lbitref - do ng=1,ngroups - glen(ng)=glen(ng)+novref - enddo - deallocate(jmin) - deallocate(jmax) - deallocate(lbit) - endif - ! - ! For each group, find the group's reference value (min) - ! and the number of bits needed to hold the remaining values - ! - n=1 - do ng=1,ngroups - ! how many of each type? - num0=count(ifldmiss(n:n+glen(ng)-1) .EQ. 0) - num1=count(ifldmiss(n:n+glen(ng)-1) .EQ. 1) - num2=count(ifldmiss(n:n+glen(ng)-1) .EQ. 2) - if ( num0.eq.0 ) then ! all missing values - if ( num1.eq.0 ) then ! all secondary missing - gref(ng)=-2 - gwidth(ng)=0 - elseif ( num2.eq.0 ) then ! all primary missing - gref(ng)=-1 - gwidth(ng)=0 - else ! both primary and secondary - gref(ng)=0 - gwidth(ng)=1 - endif - else ! contains some non-missing data - ! find max and min values of group - gref(ng)=huge(n) - imax=-1*huge(n) - j=n - do lg=1,glen(ng) - if ( ifldmiss(j).eq.0 ) then - if (ifld(j).lt.gref(ng)) gref(ng)=ifld(j) - if (ifld(j).gt.imax) imax=ifld(j) - endif - j=j+1 - enddo - if (missopt.eq.1) imax=imax+1 - if (missopt.eq.2) imax=imax+2 - ! calc num of bits needed to hold data - if ( gref(ng).ne.imax ) then - temp=alog(real(imax-gref(ng)+1))/alog2 - gwidth(ng)=ceiling(temp) - else - gwidth(ng)=0 - endif - endif - ! Subtract min from data - j=n - mtemp=2**gwidth(ng) - do lg=1,glen(ng) - if (ifldmiss(j).eq.0) then ! non-missing - ifld(j)=ifld(j)-gref(ng) - elseif (ifldmiss(j).eq.1) then ! primary missing - ifld(j)=mtemp-1 - elseif (ifldmiss(j).eq.2) then ! secondary missing - ifld(j)=mtemp-2 - endif - j=j+1 - enddo - ! increment fld array counter - n=n+glen(ng) - enddo - ! - ! Find max of the group references and calc num of bits needed - ! to pack each groups reference value, then - ! pack up group reference values - ! - !write(77,*)'GREFS: ',(gref(j),j=1,ngroups) - igmax=maxval(gref(1:ngroups)) - if (missopt.eq.1) igmax=igmax+1 - if (missopt.eq.2) igmax=igmax+2 - if (igmax.ne.0) then - temp=alog(real(igmax+1))/alog2 - nbitsgref=ceiling(temp) - ! restet the ref values of any "missing only" groups. - mtemp=2**nbitsgref - do j=1,ngroups - if (gref(j).eq.-1) gref(j)=mtemp-1 - if (gref(j).eq.-2) gref(j)=mtemp-2 - enddo - call sbytes(cpack,gref,iofst,nbitsgref,0,ngroups) - itemp=nbitsgref*ngroups - iofst=iofst+itemp - ! Pad last octet with Zeros, if necessary, - if (mod(itemp,8).ne.0) then - left=8-mod(itemp,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - else - nbitsgref=0 - endif - ! - ! Find max/min of the group widths and calc num of bits needed - ! to pack each groups width value, then - ! pack up group width values - ! - !write(77,*)'GWIDTHS: ',(gwidth(j),j=1,ngroups) - iwmax=maxval(gwidth(1:ngroups)) - ngwidthref=minval(gwidth(1:ngroups)) - if (iwmax.ne.ngwidthref) then - temp=alog(real(iwmax-ngwidthref+1))/alog2 - nbitsgwidth=ceiling(temp) - do i=1,ngroups - gwidth(i)=gwidth(i)-ngwidthref - enddo - call sbytes(cpack,gwidth,iofst,nbitsgwidth,0,ngroups) - itemp=nbitsgwidth*ngroups - iofst=iofst+itemp - ! Pad last octet with Zeros, if necessary, - if (mod(itemp,8).ne.0) then - left=8-mod(itemp,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - else - nbitsgwidth=0 - gwidth(1:ngroups)=0 - endif - ! - ! Find max/min of the group lengths and calc num of bits needed - ! to pack each groups length value, then - ! pack up group length values - ! - !write(77,*)'GLENS: ',(glen(j),j=1,ngroups) - ilmax=maxval(glen(1:ngroups-1)) - nglenref=minval(glen(1:ngroups-1)) - nglenlast=glen(ngroups) - if (ilmax.ne.nglenref) then - temp=alog(real(ilmax-nglenref+1))/alog2 - nbitsglen=ceiling(temp) - do i=1,ngroups-1 - glen(i)=glen(i)-nglenref - enddo - call sbytes(cpack,glen,iofst,nbitsglen,0,ngroups) - itemp=nbitsglen*ngroups - iofst=iofst+itemp - ! Pad last octet with Zeros, if necessary, - if (mod(itemp,8).ne.0) then - left=8-mod(itemp,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - else - nbitsglen=0 - glen(1:ngroups)=0 - endif - ! - ! For each group, pack data values - ! - !write(77,*)'IFLDS: ',(ifld(j),j=1,ndpts) - n=1 - ij=0 - do ng=1,ngroups - glength=glen(ng)+nglenref - if (ng.eq.ngroups ) glength=nglenlast - grpwidth=gwidth(ng)+ngwidthref - !write(77,*)'NGP ',ng,grpwidth,glength,gref(ng) - if ( grpwidth.ne.0 ) then - call sbytes(cpack,ifld(n),iofst,grpwidth,0,glength) - iofst=iofst+(grpwidth*glength) - endif - do kk=1,glength - ij=ij+1 - !write(77,*)'SAG ',ij,fld(ij),ifld(ij),gref(ng),bscale,rmin,dscale - enddo - n=n+glength - enddo - ! Pad last octet with Zeros, if necessary, - if (mod(iofst,8).ne.0) then - left=8-mod(iofst,8) - call sbyte(cpack,zero,iofst,left) - iofst=iofst+left - endif - lcpack=iofst/8 - ! - if ( allocated(ifld) ) deallocate(ifld) - if ( allocated(jfld) ) deallocate(jfld) - if ( allocated(ifldmiss) ) deallocate(ifldmiss) - if ( allocated(gref) ) deallocate(gref) - if ( allocated(gwidth) ) deallocate(gwidth) - if ( allocated(glen) ) deallocate(glen) - !else ! Constant field ( max = min ) - ! nbits=0 - ! lcpack=0 - ! nbitsgref=0 - ! ngroups=0 - !endif - -! -! Fill in ref value and number of bits in Template 5.2 -! - call mkieee(rmin,ref,1) ! ensure reference value is IEEE format -! call gbyte(ref,idrstmpl(1),0,32) - iref=transfer(ref,iref) - idrstmpl(1)=iref - idrstmpl(4)=nbitsgref - idrstmpl(5)=0 ! original data were reals - idrstmpl(6)=1 ! general group splitting - idrstmpl(10)=ngroups ! Number of groups - idrstmpl(11)=ngwidthref ! reference for group widths - idrstmpl(12)=nbitsgwidth ! num bits used for group widths - idrstmpl(13)=nglenref ! Reference for group lengths - idrstmpl(14)=1 ! length increment for group lengths - idrstmpl(15)=nglenlast ! True length of last group - idrstmpl(16)=nbitsglen ! num bits used for group lengths - if (idrsnum.eq.3) then - idrstmpl(18)=nbitsd/8 ! num bits used for extra spatial - ! differencing values - endif - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/mkieee.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/mkieee.f deleted file mode 100755 index 029a196a69..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/mkieee.f +++ /dev/null @@ -1,116 +0,0 @@ - subroutine mkieee(a,rieee,num) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: mkieee -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09 -! -! ABSTRACT: This subroutine stores a list of real values in -! 32-bit IEEE floating point format. -! -! PROGRAM HISTORY LOG: -! 2000-05-09 Gilbert -! -! USAGE: CALL mkieee(a,rieee,num) -! INPUT ARGUMENT LIST: -! a - Input array of floating point values. -! num - Number of floating point values to convert. -! -! OUTPUT ARGUMENT LIST: -! rieee - Output array of floating point values in 32-bit IEEE format. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - real,intent(in) :: a(num) - real(4),intent(out) :: rieee(num) - integer,intent(in) :: num - - integer(4) :: ieee - - real,save :: two23 - real,save :: two126 - integer,save :: once=0 - - if ( once .EQ. 0 ) then - once=1 - two23=scale(1.0,23) - two126=scale(1.0,126) - endif - - alog2=alog(2.0) - - do j=1,num - ieee=0 - - if (a(j).eq.0.) then - ieee=0 - rieee(j)=transfer(ieee,rieee(j)) -! write(6,fmt='(f20.10,5x,b32)') a,a -! write(6,fmt='(f20.10,5x,b32)') rieee,rieee - cycle - endif - -! -! Set Sign bit (bit 31 - leftmost bit) -! - if (a(j).lt.0.0) then - ieee=ibset(ieee,31) - atemp=abs(a(j)) - else - ieee=ibclr(ieee,31) - atemp=a(j) - endif -! -! Determine exponent n with base 2 -! - if ( atemp .ge. 1.0 ) then - n = 0 - do while ( 2.0**(n+1) .le. atemp ) - n = n + 1 - enddo - else - n = -1 - do while ( 2.0**n .gt. atemp ) - n = n - 1 - enddo - endif -! n=floor(alog(atemp)/alog2) - !write(6,*) ' logstuff ',alog(atemp)/alog2 - !write(6,*) ' logstuffn ',n - iexp=n+127 - if (n.gt.127) iexp=255 ! overflow - if (n.lt.-127) iexp=0 - ! set exponent bits ( bits 30-23 ) - call mvbits(iexp,0,8,ieee,23) -! -! Determine Mantissa -! - if (iexp.ne.255) then - if (iexp.ne.0) then - atemp=(atemp/(2.0**n))-1.0 - else - atemp=atemp*two126 - endif - imant=nint(atemp*two23) - else - imant=0 - endif - ! set mantissa bits ( bits 22-0 ) - call mvbits(imant,0,23,ieee,0) -! -! Transfer IEEE bit string to real variable -! - rieee(j)=transfer(ieee,rieee(j)) -! write(6,fmt='(f20.10,5x,b32)') a,a -! write(6,fmt='(f20.10,5x,b32)') rieee,rieee - - enddo - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/mova2i.c b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/mova2i.c deleted file mode 100755 index 167344e42d..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/mova2i.c +++ /dev/null @@ -1,68 +0,0 @@ -/*$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: mova2i Moves a bit string from a char*1 to int -C PRGMMR: Gilbert ORG: W/NP11 DATE: 02-08-15 -C -C ABSTRACT: This Function copies a bit string from a Character*1 variable -C to an integer variable. It is intended to replace the Fortran Intrinsic -C Function ICHAR, which only supports 0 <= ICHAR(a) <= 127 on the -C IBM SP. If "a" is greater than 127 in the collating sequence, -C ICHAR(a) does not return the expected bit value. -C This function can be used for all values 0 <= ICHAR(a) <= 255. -C -C PROGRAM HISTORY LOG: -C 98-12-15 Gilbert -C -C USAGE: I = mova2i(a) -C -C INPUT ARGUMENT : -C -C a - Character*1 variable that holds the bitstring to extract -C -C RETURN ARGUMENT : -C -C mova2i - Integer value of the bitstring in character a -C -C REMARKS: -C -C None -C -C ATTRIBUTES: -C LANGUAGE: C -C MACHINE: IBM SP - -C -C$$$i*/ - -#ifdef CRAY90 - #include - int MOVA2I(unsigned char *a) -#endif -#ifdef HP - int mova2i(unsigned char *a) -#endif -#ifdef SGI - int mova2i_(unsigned char *a) -#endif -#ifdef LINUX - int mova2i_(unsigned char *a) -#endif -#ifdef LINUXF90 - int MOVA2I(unsigned char *a) -#endif -#ifdef LINUXG95 - int mova2i__(unsigned char *a) -#endif -#ifdef VPP5000 - int mova2i_(unsigned char *a) -#endif -#ifdef IBM4 - int mova2i(unsigned char *a) -#endif -#ifdef IBM8 - long long int mova2i(unsigned char *a) -#endif - -{ - return (int)(*a); -} diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pack_gp.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pack_gp.f deleted file mode 100755 index 3e9ea2cbaa..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pack_gp.f +++ /dev/null @@ -1,1195 +0,0 @@ - SUBROUTINE PACK_GP(KFILDO,IC,NXY,IS523,MINPK,INC,MISSP,MISSS, - 1 JMIN,JMAX,LBIT,NOV,NDG,LX,IBIT,JBIT,KBIT, - 2 NOVREF,LBITREF,IER) -C -C FEBRUARY 1994 GLAHN TDL MOS-2000 -C JUNE 1995 GLAHN MODIFIED FOR LMISS ERROR. -C JULY 1996 GLAHN ADDED MISSS -C FEBRUARY 1997 GLAHN REMOVED 4 REDUNDANT TESTS FOR -C MISSP.EQ.0; INSERTED A TEST TO BETTER -C HANDLE A STRING OF 9999'S -C FEBRUARY 1997 GLAHN ADDED LOOPS TO ELIMINATE TEST FOR -C MISSS WHEN MISSS = 0 -C MARCH 1997 GLAHN CORRECTED FOR SECONDARY MISSING VALUE -C MARCH 1997 GLAHN CORRECTED FOR USE OF LOCAL VALUE -C OF MINPK -C MARCH 1997 GLAHN CORRECTED FOR SECONDARY MISSING VALUE -C MARCH 1997 GLAHN CHANGED CALCULATING NUMBER OF BITS -C THROUGH EXPONENTS TO AN ARRAY (IMPROVED -C OVERALL PACKING PERFORMANCE BY ABOUT -C 35 PERCENT!). ALLOWED 0 BITS FOR -C PACKING JMIN( ), LBIT( ), AND NOV( ). -C MAY 1997 GLAHN A NUMBER OF CHANGES FOR EFFICIENCY. -C MOD FUNCTIONS ELIMINATED AND ONE -C IFTHEN ADDED. JOUNT REMOVED. -C RECOMPUTATION OF BITS NOT MADE UNLESS -C NECESSARY AFTER MOVING POINTS FROM -C ONE GROUP TO ANOTHER. NENDB ADJUSTED -C TO ELIMINATE POSSIBILITY OF VERY -C SMALL GROUP AT THE END. -C ABOUT 8 PERCENT IMPROVEMENT IN -C OVERALL PACKING. ISKIPA REMOVED; -C THERE IS ALWAYS A GROUP B THAT CAN -C BECOME GROUP A. CONTROL ON SIZE -C OF GROUP B (STATEMENT BELOW 150) -C ADDED. ADDED ADDA, AND USE -C OF GE AND LE INSTEAD OF GT AND LT -C IN LOOPS BETWEEN 150 AND 160. -C IBITBS ADDED TO SHORTEN TRIPS -C THROUGH LOOP. -C MARCH 2000 GLAHN MODIFIED FOR GRIB2; CHANGED NAME FROM -C PACKGP -C JANUARY 2001 GLAHN COMMENTS; IER = 706 SUBSTITUTED FOR -C STOPS; ADDED RETURN1; REMOVED STATEMENT -C NUMBER 110; ADDED IER AND * RETURN -C NOVEMBER 2001 GLAHN CHANGED SOME DIAGNOSTIC FORMATS TO -C ALLOW PRINTING LARGER NUMBERS -C NOVEMBER 2001 GLAHN ADDED MISSLX( ) TO PUT MAXIMUM VALUE -C INTO JMIN( ) WHEN ALL VALUES MISSING -C TO AGREE WITH GRIB STANDARD. -C NOVEMBER 2001 GLAHN CHANGED TWO TESTS ON MISSP AND MISSS -C EQ 0 TO TESTS ON IS523. HOWEVER, -C MISSP AND MISSS CANNOT IN GENERAL BE -C = 0. -C NOVEMBER 2001 GLAHN ADDED CALL TO REDUCE; DEFINED ITEST -C BEFORE LOOPS TO REDUCE COMPUTATION; -C STARTED LARGE GROUP WHEN ALL SAME -C VALUE -C DECEMBER 2001 GLAHN MODIFIED AND ADDED A FEW COMMENTS -C JANUARY 2002 GLAHN REMOVED LOOP BEFORE 150 TO DETERMINE -C A GROUP OF ALL SAME VALUE -C JANUARY 2002 GLAHN CHANGED MALLOW FROM 9999999 TO 2**30+1, -C AND MADE IT A PARAMETER -C MARCH 2002 GLAHN ADDED NON FATAL IER = 716, 717; -C REMOVED NENDB=NXY ABOVE 150; -C ADDED IERSAV=0; COMMENTS -C -C PURPOSE -C DETERMINES GROUPS OF VARIABLE SIZE, BUT AT LEAST OF -C SIZE MINPK, THE ASSOCIATED MAX (JMAX( )) AND MIN (JMIN( )), -C THE NUMBER OF BITS NECESSARY TO HOLD THE VALUES IN EACH -C GROUP (LBIT( )), THE NUMBER OF VALUES IN EACH GROUP -C (NOV( )), THE NUMBER OF BITS NECESSARY TO PACK THE JMIN( ) -C VALUES (IBIT), THE NUMBER OF BITS NECESSARY TO PACK THE -C LBIT( ) VALUES (JBIT), AND THE NUMBER OF BITS NECESSARY -C TO PACK THE NOV( ) VALUES (KBIT). THE ROUTINE IS DESIGNED -C TO DETERMINE THE GROUPS SUCH THAT A SMALL NUMBER OF BITS -C IS NECESSARY TO PACK THE DATA WITHOUT EXCESSIVE -C COMPUTATIONS. IF ALL VALUES IN THE GROUP ARE ZERO, THE -C NUMBER OF BITS TO USE IN PACKING IS DEFINED AS ZERO WHEN -C THERE CAN BE NO MISSING VALUES; WHEN THERE CAN BE MISSING -C VALUES, THE NUMBER OF BITS MUST BE AT LEAST 1 TO HAVE -C THE CAPABILITY TO RECOGNIZE THE MISSING VALUE. HOWEVER, -C IF ALL VALUES IN A GROUP ARE MISSING, THE NUMBER OF BITS -C NEEDED IS 0, AND THE UNPACKER RECOGNIZES THIS. -C ALL VARIABLES ARE INTEGER. EVEN THOUGH THE GROUPS ARE -C INITIALLY OF SIZE MINPK OR LARGER, AN ADJUSTMENT BETWEEN -C TWO GROUPS (THE LOOKBACK PROCEDURE) MAY MAKE A GROUP -C SMALLER THAN MINPK. THE CONTROL ON GROUP SIZE IS THAT -C THE SUM OF THE SIZES OF THE TWO CONSECUTIVE GROUPS, EACH OF -C SIZE MINPK OR LARGER, IS NOT DECREASED. WHEN DETERMINING -C THE NUMBER OF BITS NECESSARY FOR PACKING, THE LARGEST -C VALUE THAT CAN BE ACCOMMODATED IN, SAY, MBITS, IS -C 2**MBITS-1; THIS LARGEST VALUE (AND THE NEXT SMALLEST -C VALUE) IS RESERVED FOR THE MISSING VALUE INDICATOR (ONLY) -C WHEN IS523 NE 0. IF THE DIMENSION NDG -C IS NOT LARGE ENOUGH TO HOLD ALL THE GROUPS, THE LOCAL VALUE -C OF MINPK IS INCREASED BY 50 PERCENT. THIS IS REPEATED -C UNTIL NDG WILL SUFFICE. A DIAGNOSTIC IS PRINTED WHENEVER -C THIS HAPPENS, WHICH SHOULD BE VERY RARELY. IF IT HAPPENS -C OFTEN, NDG IN SUBROUTINE PACK SHOULD BE INCREASED AND -C A CORRESPONDING INCREASE IN SUBROUTINE UNPACK MADE. -C CONSIDERABLE CODE IS PROVIDED SO THAT NO MORE CHECKING -C FOR MISSING VALUES WITHIN LOOPS IS DONE THAN NECESSARY; -C THE ADDED EFFICIENCY OF THIS IS RELATIVELY MINOR, -C BUT DOES NO HARM. FOR GRIB2, THE REFERENCE VALUE FOR -C THE LENGTH OF GROUPS IN NOV( ) AND FOR THE NUMBER OF -C BITS NECESSARY TO PACK GROUP VALUES ARE DETERMINED, -C AND SUBTRACTED BEFORE JBIT AND KBIT ARE DETERMINED. -C -C WHEN 1 OR MORE GROUPS ARE LARGE COMPARED TO THE OTHERS, -C THE WIDTH OF ALL GROUPS MUST BE AS LARGE AS THE LARGEST. -C A SUBROUTINE REDUCE BREAKS UP LARGE GROUPS INTO 2 OR -C MORE TO REDUCE TOTAL BITS REQUIRED. IF REDUCE SHOULD -C ABORT, PACK_GP WILL BE EXECUTED AGAIN WITHOUT THE CALL -C TO REDUCE. -C -C DATA SET USE -C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) -C -C VARIABLES IN CALL SEQUENCE -C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) -C IC( ) = ARRAY TO HOLD DATA FOR PACKING. THE VALUES -C DO NOT HAVE TO BE POSITIVE AT THIS POINT, BUT -C MUST BE IN THE RANGE -2**30 TO +2**30 (THE -C THE VALUE OF MALLOW). THESE INTEGER VALUES -C WILL BE RETAINED EXACTLY THROUGH PACKING AND -C UNPACKING. (INPUT) -C NXY = NUMBER OF VALUES IN IC( ). ALSO TREATED -C AS ITS DIMENSION. (INPUT) -C IS523 = missing value management -C 0=data contains no missing values -C 1=data contains Primary missing values -C 2=data contains Primary and secondary missing values -C (INPUT) -C MINPK = THE MINIMUM SIZE OF EACH GROUP, EXCEPT POSSIBLY -C THE LAST ONE. (INPUT) -C INC = THE NUMBER OF VALUES TO ADD TO AN ALREADY -C EXISTING GROUP IN DETERMINING WHETHER OR NOT -C TO START A NEW GROUP. IDEALLY, THIS WOULD BE -C 1, BUT EACH TIME INC VALUES ARE ATTEMPTED, THE -C MAX AND MIN OF THE NEXT MINPK VALUES MUST BE -C FOUND. THIS IS "A LOOP WITHIN A LOOP," AND -C A SLIGHTLY LARGER VALUE MAY GIVE ABOUT AS GOOD -C RESULTS WITH SLIGHTLY LESS COMPUTATIONAL TIME. -C IF INC IS LE 0, 1 IS USED, AND A DIAGNOSTIC IS -C OUTPUT. NOTE: IT IS EXPECTED THAT INC WILL -C EQUAL 1. THE CODE USES INC PRIMARILY IN THE -C LOOPS STARTING AT STATEMENT 180. IF INC -C WERE 1, THERE WOULD NOT NEED TO BE LOOPS -C AS SUCH. HOWEVER, KINC (THE LOCAL VALUE OF -C INC) IS SET GE 1 WHEN NEAR THE END OF THE DATA -C TO FORESTALL A VERY SMALL GROUP AT THE END. -C (INPUT) -C MISSP = WHEN MISSING POINTS CAN BE PRESENT IN THE DATA, -C THEY WILL HAVE THE VALUE MISSP OR MISSS. -C MISSP IS THE PRIMARY MISSING VALUE AND MISSS -C IS THE SECONDARY MISSING VALUE . THESE MUST -C NOT BE VALUES THAT WOULD OCCUR WITH SUBTRACTING -C THE MINIMUM (REFERENCE) VALUE OR SCALING. -C FOR EXAMPLE, MISSP = 0 WOULD NOT BE ADVISABLE. -C (INPUT) -C MISSS = SECONDARY MISSING VALUE INDICATOR (SEE MISSP). -C (INPUT) -C JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX). (OUTPUT) -C JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). THIS IS -C NOT REALLY NEEDED, BUT SINCE THE MAX OF EACH -C GROUP MUST BE FOUND, SAVING IT HERE IS CHEAP -C IN CASE THE USER WANTS IT. (OUTPUT) -C LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP -C (J=1,LX). IT IS ASSUMED THE MINIMUM OF EACH -C GROUP WILL BE REMOVED BEFORE PACKING, AND THE -C VALUES TO PACK WILL, THEREFORE, ALL BE POSITIVE. -C HOWEVER, IC( ) DOES NOT NECESSARILY CONTAIN -C ALL POSITIVE VALUES. IF THE OVERALL MINIMUM -C HAS BEEN REMOVED (THE USUAL CASE), THEN IC( ) -C WILL CONTAIN ONLY POSITIVE VALUES. (OUTPUT) -C NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX). -C (OUTPUT) -C NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND -C NOV( ). (INPUT) -C LX = THE NUMBER OF GROUPS DETERMINED. (OUTPUT) -C IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J) -C VALUES, J=1,LX. (OUTPUT) -C JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J) -C VALUES, J=1,LX. (OUTPUT) -C KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J) -C VALUES, J=1,LX. (OUTPUT) -C NOVREF = REFERENCE VALUE FOR NOV( ). (OUTPUT) -C LBITREF = REFERENCE VALUE FOR LBIT( ). (OUTPUT) -C IER = ERROR RETURN. -C 706 = VALUE WILL NOT PACK IN 30 BITS--FATAL -C 714 = ERROR IN REDUCE--NON-FATAL -C 715 = NGP NOT LARGE ENOUGH IN REDUCE--NON-FATAL -C 716 = MINPK INCEASED--NON-FATAL -C 717 = INC SET = 1--NON-FATAL -C (OUTPUT) -C * = ALTERNATE RETURN WHEN IER NE 0 AND FATAL ERROR. -C -C INTERNAL VARIABLES -C CFEED = CONTAINS THE CHARACTER REPRESENTATION -C OF A PRINTER FORM FEED. -C IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER -C FORM FEED. -C KINC = WORKING COPY OF INC. MAY BE MODIFIED. -C MINA = MINIMUM VALUE IN GROUP A. -C MAXA = MAXIMUM VALUE IN GROUP A. -C NENDA = THE PLACE IN IC( ) WHERE GROUP A ENDS. -C KSTART = THE PLACE IN IC( ) WHERE GROUP A STARTS. -C IBITA = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP A. -C MINB = MINIMUM VALUE IN GROUP B. -C MAXB = MAXIMUM VALUE IN GROUP B. -C NENDB = THE PLACE IN IC( ) WHERE GROUP B ENDS. -C IBITB = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP B. -C MINC = MINIMUM VALUE IN GROUP C. -C MAXC = MAXIMUM VALUE IN GROUP C. -C KTOTAL = COUNT OF NUMBER OF VALUES IN IC( ) PROCESSED. -C NOUNT = NUMBER OF VALUES ADDED TO GROUP A. -C LMISS = 0 WHEN IS523 = 0. WHEN PACKING INTO A -C SPECIFIC NUMBER OF BITS, SAY MBITS, -C THE MAXIMUM VALUE THAT CAN BE HANDLED IS -C 2**MBITS-1. WHEN IS523 = 1, INDICATING -C PRIMARY MISSING VALUES, THIS MAXIMUM VALUE -C IS RESERVED TO HOLD THE PRIMARY MISSING VALUE -C INDICATOR AND LMISS = 1. WHEN IS523 = 2, -C THE VALUE JUST BELOW THE MAXIMUM (I.E., -C 2**MBITS-2) IS RESERVED TO HOLD THE SECONDARY -C MISSING VALUE INDICATOR AND LMISS = 2. -C LMINPK = LOCAL VALUE OF MINPK. THIS WILL BE ADJUSTED -C UPWARD WHENEVER NDG IS NOT LARGE ENOUGH TO HOLD -C ALL THE GROUPS. -C MALLOW = THE LARGEST ALLOWABLE VALUE FOR PACKING. -C MISLLA = SET TO 1 WHEN ALL VALUES IN GROUP A ARE MISSING. -C THIS IS USED TO DISTINGUISH BETWEEN A REAL -C MINIMUM WHEN ALL VALUES ARE NOT MISSING -C AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN -C ALL VALUES ARE MISSING. 0 OTHERWISE. -C NOTE THAT THIS DOES NOT DISTINGUISH BETWEEN -C PRIMARY AND SECONDARY MISSINGS WHEN SECONDARY -C MISSINGS ARE PRESENT. THIS MEANS THAT -C LBIT( ) WILL NOT BE ZERO WITH THE RESULTING -C COMPRESSION EFFICIENCY WHEN SECONDARY MISSINGS -C ARE PRESENT. ALSO NOTE THAT A CHECK HAS BEEN -C MADE EARLIER TO DETERMINE THAT SECONDARY -C MISSINGS ARE REALLY THERE. -C MISLLB = SET TO 1 WHEN ALL VALUES IN GROUP B ARE MISSING. -C THIS IS USED TO DISTINGUISH BETWEEN A REAL -C MINIMUM WHEN ALL VALUES ARE NOT MISSING -C AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN -C ALL VALUES ARE MISSING. 0 OTHERWISE. -C MISLLC = PERFORMS THE SAME FUNCTION FOR GROUP C THAT -C MISLLA AND MISLLB DO FOR GROUPS B AND C, -C RESPECTIVELY. -C IBXX2(J) = AN ARRAY THAT WHEN THIS ROUTINE IS FIRST ENTERED -C IS SET TO 2**J, J=0,30. IBXX2(30) = 2**30, WHICH -C IS THE LARGEST VALUE PACKABLE, BECAUSE 2**31 -C IS LARGER THAN THE INTEGER WORD SIZE. -C IFIRST = SET BY DATA STATEMENT TO 0. CHANGED TO 1 ON -C FIRST -C ENTRY WHEN IBXX2( ) IS FILLED. -C MINAK = KEEPS TRACK OF THE LOCATION IN IC( ) WHERE THE -C MINIMUM VALUE IN GROUP A IS LOCATED. -C MAXAK = DOES THE SAME AS MINAK, EXCEPT FOR THE MAXIMUM. -C MINBK = THE SAME AS MINAK FOR GROUP B. -C MAXBK = THE SAME AS MAXAK FOR GROUP B. -C MINCK = THE SAME AS MINAK FOR GROUP C. -C MAXCK = THE SAME AS MAXAK FOR GROUP C. -C ADDA = KEEPS TRACK WHETHER OR NOT AN ATTEMPT TO ADD -C POINTS TO GROUP A WAS MADE. IF SO, THEN ADDA -C KEEPS FROM TRYING TO PUT ONE BACK INTO B. -C (LOGICAL) -C IBITBS = KEEPS CURRENT VALUE IF IBITB SO THAT LOOP -C ENDING AT 166 DOESN'T HAVE TO START AT -C IBITB = 0 EVERY TIME. -C MISSLX(J) = MALLOW EXCEPT WHEN A GROUP IS ALL ONE VALUE (AND -C LBIT(J) = 0) AND THAT VALUE IS MISSING. IN -C THAT CASE, MISSLX(J) IS MISSP OR MISSS. THIS -C GETS INSERTED INTO JMIN(J) LATER AS THE -C MISSING INDICATOR; IT CAN'T BE PUT IN UNTIL -C THE END, BECAUSE JMIN( ) IS USED TO CALCULATE -C THE MAXIMUM NUMBER OF BITS (IBITS) NEEDED TO -C PACK JMIN( ). -C 1 2 3 4 5 6 7 X -C -C NON SYSTEM SUBROUTINES CALLED -C NONE -C - PARAMETER (MALLOW=2**30+1) -C - CHARACTER*1 CFEED - LOGICAL ADDA -C - DIMENSION IC(NXY) - DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG) - DIMENSION MISSLX(NDG) -C MISSLX( ) IS AN AUTOMATIC ARRAY. - DIMENSION IBXX2(0:30) -C - SAVE IBXX2 -C - DATA IFEED/12/ - DATA IFIRST/0/ -C - IER=0 - IERSAV=0 -C CALL TIMPR(KFILDO,KFILDO,'START PACK_GP ') - CFEED=CHAR(IFEED) -C - IRED=0 -C IRED IS A FLAG. WHEN ZERO, REDUCE WILL BE CALLED. -C IF REDUCE ABORTS, IRED = 1 AND IS NOT CALLED. IN -C THIS CASE PACK_GP EXECUTES AGAIN EXCEPT FOR REDUCE. -C - IF(INC.LE.0)THEN - IERSAV=717 -C WRITE(KFILDO,101)INC -C101 FORMAT(/' ****INC ='I8,' NOT CORRECT IN PACK_GP. 1 IS USED.') - ENDIF -C -C THERE WILL BE A RESTART OF PACK_GP IF SUBROUTINE REDUCE -C ABORTS. THIS SHOULD NOT HAPPEN, BUT IF IT DOES, PACK_GP -C WILL COMPLETE WITHOUT SUBROUTINE REDUCE. A NON FATAL -C DIAGNOSTIC RETURN IS PROVIDED. -C - 102 KINC=MAX(INC,1) - LMINPK=MINPK -C -C CALCULATE THE POWERS OF 2 THE FIRST TIME ENTERED. -C - IF(IFIRST.EQ.0)THEN - IFIRST=1 - IBXX2(0)=1 -C - DO 104 J=1,30 - IBXX2(J)=IBXX2(J-1)*2 - 104 CONTINUE -C - ENDIF -C -C THERE WILL BE A RESTART AT 105 IS NDG IS NOT LARGE ENOUGH. -C A NON FATAL DIAGNOSTIC RETURN IS PROVIDED. -C - 105 KSTART=1 - KTOTAL=0 - LX=0 - ADDA=.FALSE. - LMISS=0 - IF(IS523.EQ.1)LMISS=1 - IF(IS523.EQ.2)LMISS=2 -C -C ************************************* -C -C THIS SECTION COMPUTES STATISTICS FOR GROUP A. GROUP A IS -C A GROUP OF SIZE LMINPK. -C -C ************************************* -C - IBITA=0 - MINA=MALLOW - MAXA=-MALLOW - MINAK=MALLOW - MAXAK=-MALLOW -C -C FIND THE MIN AND MAX OF GROUP A. THIS WILL INITIALLY BE OF -C SIZE LMINPK (IF THERE ARE STILL LMINPK VALUES IN IC( )), BUT -C WILL INCREASE IN SIZE IN INCREMENTS OF INC UNTIL A NEW -C GROUP IS STARTED. THE DEFINITION OF GROUP A IS DONE HERE -C ONLY ONCE (UPON INITIAL ENTRY), BECAUSE A GROUP B CAN ALWAYS -C BECOME A NEW GROUP A AFTER A IS PACKED, EXCEPT IF LMINPK -C HAS TO BE INCREASED BECAUSE NDG IS TOO SMALL. THEREFORE, -C THE SEPARATE LOOPS FOR MISSING AND NON-MISSING HERE BUYS -C ALMOST NOTHING. -C - NENDA=MIN(KSTART+LMINPK-1,NXY) - IF(NXY-NENDA.LE.LMINPK/2)NENDA=NXY -C ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY -C MAKING THE ACTUAL GROUP LARGER. IF A PROVISION LIKE THIS IS -C NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP -C AT THE END. USE SEPARATE LOOPS FOR MISSING AND NO MISSING -C VALUES FOR EFFICIENCY. -C -C DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE -C UNLESS NENDA = NXY. THIS MAY ALLOW A LARGE GROUP A TO -C START WITH, AS WITH MISSING VALUES. SEPARATE LOOPS FOR -C MISSING OPTIONS. THIS SECTION IS ONLY EXECUTED ONCE, -C IN DETERMINING THE FIRST GROUP. IT HELPS FOR AN ARRAY -C OF MOSTLY MISSING VALUES OR OF ONE VALUE, SUCH AS -C RADAR OR PRECIP DATA. -C - IF(NENDA.NE.NXY.AND.IC(KSTART).EQ.IC(KSTART+1))THEN -C NO NEED TO EXECUTE IF FIRST TWO VALUES ARE NOT EQUAL. -C - IF(IS523.EQ.0)THEN -C THIS LOOP IS FOR NO MISSING VALUES. -C - DO 111 K=KSTART+1,NXY -C - IF(IC(K).NE.IC(KSTART))THEN - NENDA=MAX(NENDA,K-1) - GO TO 114 - ENDIF -C - 111 CONTINUE -C - NENDA=NXY -C FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME. -C - ELSEIF(IS523.EQ.1)THEN -C THIS LOOP IS FOR PRIMARY MISSING VALUES ONLY. -C - DO 112 K=KSTART+1,NXY -C - IF(IC(K).NE.MISSP)THEN -C - IF(IC(K).NE.IC(KSTART))THEN - NENDA=MAX(NENDA,K-1) - GO TO 114 - ENDIF -C - ENDIF -C - 112 CONTINUE -C - NENDA=NXY -C FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME. -C - ELSE -C THIS LOOP IS FOR PRIMARY AND SECONDARY MISSING VALUES. -C - DO 113 K=KSTART+1,NXY -C - IF(IC(K).NE.MISSP.AND.IC(K).NE.MISSS)THEN -C - IF(IC(K).NE.IC(KSTART))THEN - NENDA=MAX(NENDA,K-1) - GO TO 114 - ENDIF -C - ENDIF -C - 113 CONTINUE -C - NENDA=NXY -C FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME. - ENDIF -C - ENDIF -C - 114 IF(IS523.EQ.0)THEN -C - DO 115 K=KSTART,NENDA - IF(IC(K).LT.MINA)THEN - MINA=IC(K) - MINAK=K - ENDIF - IF(IC(K).GT.MAXA)THEN - MAXA=IC(K) - MAXAK=K - ENDIF - 115 CONTINUE -C - ELSEIF(IS523.EQ.1)THEN -C - DO 117 K=KSTART,NENDA - IF(IC(K).EQ.MISSP)GO TO 117 - IF(IC(K).LT.MINA)THEN - MINA=IC(K) - MINAK=K - ENDIF - IF(IC(K).GT.MAXA)THEN - MAXA=IC(K) - MAXAK=K - ENDIF - 117 CONTINUE -C - ELSE -C - DO 120 K=KSTART,NENDA - IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 120 - IF(IC(K).LT.MINA)THEN - MINA=IC(K) - MINAK=K - ENDIF - IF(IC(K).GT.MAXA)THEN - MAXA=IC(K) - MAXAK=K - ENDIF - 120 CONTINUE -C - ENDIF -C - KOUNTA=NENDA-KSTART+1 -C -C INCREMENT KTOTAL AND FIND THE BITS NEEDED TO PACK THE A GROUP. -C - KTOTAL=KTOTAL+KOUNTA - MISLLA=0 - IF(MINA.NE.MALLOW)GO TO 125 -C ALL MISSING VALUES MUST BE ACCOMMODATED. - MINA=0 - MAXA=0 - MISLLA=1 - IBITB=0 - IF(IS523.NE.2)GO TO 130 -C WHEN ALL VALUES ARE MISSING AND THERE ARE NO -C SECONDARY MISSING VALUES, IBITA = 0. -C OTHERWISE, IBITA MUST BE CALCULATED. -C - 125 ITEST=MAXA-MINA+LMISS -C - DO 126 IBITA=0,30 - IF(ITEST.LT.IBXX2(IBITA))GO TO 130 -C*** THIS TEST IS THE SAME AS: -C*** IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 130 - 126 CONTINUE -C -C WRITE(KFILDO,127)MAXA,MINA -C127 FORMAT(' ****ERROR IN PACK_GP. VALUE WILL NOT PACK IN 30 BITS.', -C 1 ' MAXA ='I13,' MINA ='I13,'. ERROR AT 127.') - IER=706 - GO TO 900 -C - 130 CONTINUE -C -C***D WRITE(KFILDO,131)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA -C***D131 FORMAT(' AT 130, KOUNTA ='I8,' KTOTAL ='I8,' MINA ='I8, -C***D 1 ' MAXA ='I8,' IBITA ='I3,' MISLLA ='I3) -C - 133 IF(KTOTAL.GE.NXY)GO TO 200 -C -C ************************************* -C -C THIS SECTION COMPUTES STATISTICS FOR GROUP B. GROUP B IS A -C GROUP OF SIZE LMINPK IMMEDIATELY FOLLOWING GROUP A. -C -C ************************************* -C - 140 MINB=MALLOW - MAXB=-MALLOW - MINBK=MALLOW - MAXBK=-MALLOW - IBITBS=0 - MSTART=KTOTAL+1 -C -C DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE. -C THIS WORKS WHEN THERE ARE NO MISSING VALUES. -C - NENDB=1 -C - IF(MSTART.LT.NXY)THEN -C - IF(IS523.EQ.0)THEN -C THIS LOOP IS FOR NO MISSING VALUES. -C - DO 145 K=MSTART+1,NXY -C - IF(IC(K).NE.IC(MSTART))THEN - NENDB=K-1 - GO TO 150 - ENDIF -C - 145 CONTINUE -C - NENDB=NXY -C FALL THROUGH THE LOOP MEANS ALL REMAINING VALUES -C ARE THE SAME. - ENDIF -C - ENDIF -C - 150 NENDB=MAX(NENDB,MIN(KTOTAL+LMINPK,NXY)) -C**** 150 NENDB=MIN(KTOTAL+LMINPK,NXY) -C - IF(NXY-NENDB.LE.LMINPK/2)NENDB=NXY -C ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY -C MAKING THE ACTUAL GROUP LARGER. IF A PROVISION LIKE THIS IS -C NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP -C AT THE END. USE SEPARATE LOOPS FOR MISSING AND NO MISSING -C -C USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES -C FOR EFFICIENCY. -C - IF(IS523.EQ.0)THEN -C - DO 155 K=MSTART,NENDB - IF(IC(K).LE.MINB)THEN - MINB=IC(K) -C NOTE LE, NOT LT. LT COULD BE USED BUT THEN A -C RECOMPUTE OVER THE WHOLE GROUP WOULD BE NEEDED -C MORE OFTEN. SAME REASONING FOR GE AND OTHER -C LOOPS BELOW. - MINBK=K - ENDIF - IF(IC(K).GE.MAXB)THEN - MAXB=IC(K) - MAXBK=K - ENDIF - 155 CONTINUE -C - ELSEIF(IS523.EQ.1)THEN -C - DO 157 K=MSTART,NENDB - IF(IC(K).EQ.MISSP)GO TO 157 - IF(IC(K).LE.MINB)THEN - MINB=IC(K) - MINBK=K - ENDIF - IF(IC(K).GE.MAXB)THEN - MAXB=IC(K) - MAXBK=K - ENDIF - 157 CONTINUE -C - ELSE -C - DO 160 K=MSTART,NENDB - IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 160 - IF(IC(K).LE.MINB)THEN - MINB=IC(K) - MINBK=K - ENDIF - IF(IC(K).GE.MAXB)THEN - MAXB=IC(K) - MAXBK=K - ENDIF - 160 CONTINUE -C - ENDIF -C - KOUNTB=NENDB-KTOTAL - MISLLB=0 - IF(MINB.NE.MALLOW)GO TO 165 -C ALL MISSING VALUES MUST BE ACCOMMODATED. - MINB=0 - MAXB=0 - MISLLB=1 - IBITB=0 -C - IF(IS523.NE.2)GO TO 170 -C WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY -C MISSING VALUES, IBITB = 0. OTHERWISE, IBITB MUST BE -C CALCULATED. -C - 165 DO 166 IBITB=IBITBS,30 - IF(MAXB-MINB.LT.IBXX2(IBITB)-LMISS)GO TO 170 - 166 CONTINUE -C -C WRITE(KFILDO,167)MAXB,MINB -C167 FORMAT(' ****ERROR IN PACK_GP. VALUE WILL NOT PACK IN 30 BITS.', -C 1 ' MAXB ='I13,' MINB ='I13,'. ERROR AT 167.') - IER=706 - GO TO 900 -C -C COMPARE THE BITS NEEDED TO PACK GROUP B WITH THOSE NEEDED -C TO PACK GROUP A. IF IBITB GE IBITA, TRY TO ADD TO GROUP A. -C IF NOT, TRY TO ADD A'S POINTS TO B, UNLESS ADDITION TO A -C HAS BEEN DONE. THIS LATTER IS CONTROLLED WITH ADDA. -C - 170 CONTINUE -C -C***D WRITE(KFILDO,171)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA, -C***D 1 MINB,MAXB,IBITB,MISLLB -C***D171 FORMAT(' AT 171, KOUNTA ='I8,' KTOTAL ='I8,' MINA ='I8, -C***D 1 ' MAXA ='I8,' IBITA ='I3,' MISLLA ='I3, -C***D 2 ' MINB ='I8,' MAXB ='I8,' IBITB ='I3,' MISLLB ='I3) -C - IF(IBITB.GE.IBITA)GO TO 180 - IF(ADDA)GO TO 200 -C -C ************************************* -C -C GROUP B REQUIRES LESS BITS THAN GROUP A. PUT AS MANY OF A'S -C POINTS INTO B AS POSSIBLE WITHOUT EXCEEDING THE NUMBER OF -C BITS NECESSARY TO PACK GROUP B. -C -C ************************************* -C - KOUNTS=KOUNTA -C KOUNTA REFERS TO THE PRESENT GROUP A. - MINTST=MINB - MAXTST=MAXB - MINTSTK=MINBK - MAXTSTK=MAXBK -C -C USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES -C FOR EFFICIENCY. -C - IF(IS523.EQ.0)THEN -C - DO 1715 K=KTOTAL,KSTART,-1 -C START WITH THE END OF THE GROUP AND WORK BACKWARDS. - IF(IC(K).LT.MINB)THEN - MINTST=IC(K) - MINTSTK=K - ELSEIF(IC(K).GT.MAXB)THEN - MAXTST=IC(K) - MAXTSTK=K - ENDIF - IF(MAXTST-MINTST.GE.IBXX2(IBITB))GO TO 174 -C NOTE THAT FOR THIS LOOP, LMISS = 0. - MINB=MINTST - MAXB=MAXTST - MINBK=MINTSTK - MAXBK=MAXTSTK - KOUNTA=KOUNTA-1 -C THERE IS ONE LESS POINT NOW IN A. - 1715 CONTINUE -C - ELSEIF(IS523.EQ.1)THEN -C - DO 1719 K=KTOTAL,KSTART,-1 -C START WITH THE END OF THE GROUP AND WORK BACKWARDS. - IF(IC(K).EQ.MISSP)GO TO 1718 - IF(IC(K).LT.MINB)THEN - MINTST=IC(K) - MINTSTK=K - ELSEIF(IC(K).GT.MAXB)THEN - MAXTST=IC(K) - MAXTSTK=K - ENDIF - IF(MAXTST-MINTST.GE.IBXX2(IBITB)-LMISS)GO TO 174 -C FOR THIS LOOP, LMISS = 1. - MINB=MINTST - MAXB=MAXTST - MINBK=MINTSTK - MAXBK=MAXTSTK - MISLLB=0 -C WHEN THE POINT IS NON MISSING, MISLLB SET = 0. - 1718 KOUNTA=KOUNTA-1 -C THERE IS ONE LESS POINT NOW IN A. - 1719 CONTINUE -C - ELSE -C - DO 173 K=KTOTAL,KSTART,-1 -C START WITH THE END OF THE GROUP AND WORK BACKWARDS. - IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 1729 - IF(IC(K).LT.MINB)THEN - MINTST=IC(K) - MINTSTK=K - ELSEIF(IC(K).GT.MAXB)THEN - MAXTST=IC(K) - MAXTSTK=K - ENDIF - IF(MAXTST-MINTST.GE.IBXX2(IBITB)-LMISS)GO TO 174 -C FOR THIS LOOP, LMISS = 2. - MINB=MINTST - MAXB=MAXTST - MINBK=MINTSTK - MAXBK=MAXTSTK - MISLLB=0 -C WHEN THE POINT IS NON MISSING, MISLLB SET = 0. - 1729 KOUNTA=KOUNTA-1 -C THERE IS ONE LESS POINT NOW IN A. - 173 CONTINUE -C - ENDIF -C -C AT THIS POINT, KOUNTA CONTAINS THE NUMBER OF POINTS TO CLOSE -C OUT GROUP A WITH. GROUP B NOW STARTS WITH KSTART+KOUNTA AND -C ENDS WITH NENDB. MINB AND MAXB HAVE BEEN ADJUSTED AS -C NECESSARY TO REFLECT GROUP B (EVEN THOUGH THE NUMBER OF BITS -C NEEDED TO PACK GROUP B HAVE NOT INCREASED, THE END POINTS -C OF THE RANGE MAY HAVE). -C - 174 IF(KOUNTA.EQ.KOUNTS)GO TO 200 -C ON TRANSFER, GROUP A WAS NOT CHANGED. CLOSE IT OUT. -C -C ONE OR MORE POINTS WERE TAKEN OUT OF A. RANGE AND IBITA -C MAY HAVE TO BE RECOMPUTED; IBITA COULD BE LESS THAN -C ORIGINALLY COMPUTED. IN FACT, GROUP A CAN NOW CONTAIN -C ONLY ONE POINT AND BE PACKED WITH ZERO BITS -C (UNLESS MISSS NE 0). -C - NOUTA=KOUNTS-KOUNTA - KTOTAL=KTOTAL-NOUTA - KOUNTB=KOUNTB+NOUTA - IF(NENDA-NOUTA.GT.MINAK.AND.NENDA-NOUTA.GT.MAXAK)GO TO 200 -C WHEN THE ABOVE TEST IS MET, THE MIN AND MAX OF THE -C CURRENT GROUP A WERE WITHIN THE OLD GROUP A, SO THE -C RANGE AND IBITA DO NOT NEED TO BE RECOMPUTED. -C NOTE THAT MINAK AND MAXAK ARE NO LONGER NEEDED. - IBITA=0 - MINA=MALLOW - MAXA=-MALLOW -C -C USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES -C FOR EFFICIENCY. -C - IF(IS523.EQ.0)THEN -C - DO 1742 K=KSTART,NENDA-NOUTA - IF(IC(K).LT.MINA)THEN - MINA=IC(K) - ENDIF - IF(IC(K).GT.MAXA)THEN - MAXA=IC(K) - ENDIF - 1742 CONTINUE -C - ELSEIF(IS523.EQ.1)THEN -C - DO 1744 K=KSTART,NENDA-NOUTA - IF(IC(K).EQ.MISSP)GO TO 1744 - IF(IC(K).LT.MINA)THEN - MINA=IC(K) - ENDIF - IF(IC(K).GT.MAXA)THEN - MAXA=IC(K) - ENDIF - 1744 CONTINUE -C - ELSE -C - DO 175 K=KSTART,NENDA-NOUTA - IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 175 - IF(IC(K).LT.MINA)THEN - MINA=IC(K) - ENDIF - IF(IC(K).GT.MAXA)THEN - MAXA=IC(K) - ENDIF - 175 CONTINUE -C - ENDIF -C - MISLLA=0 - IF(MINA.NE.MALLOW)GO TO 1750 -C ALL MISSING VALUES MUST BE ACCOMMODATED. - MINA=0 - MAXA=0 - MISLLA=1 - IF(IS523.NE.2)GO TO 177 -C WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY -C MISSING VALUES IBITA = 0 AS ORIGINALLY SET. OTHERWISE, -C IBITA MUST BE CALCULATED. -C - 1750 ITEST=MAXA-MINA+LMISS -C - DO 176 IBITA=0,30 - IF(ITEST.LT.IBXX2(IBITA))GO TO 177 -C*** THIS TEST IS THE SAME AS: -C*** IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 177 - 176 CONTINUE -C -C WRITE(KFILDO,1760)MAXA,MINA -C1760 FORMAT(' ****ERROR IN PACK_GP. VALUE WILL NOT PACK IN 30 BITS.', -C 1 ' MAXA ='I13,' MINA ='I13,'. ERROR AT 1760.') - IER=706 - GO TO 900 -C - 177 CONTINUE - GO TO 200 -C -C ************************************* -C -C AT THIS POINT, GROUP B REQUIRES AS MANY BITS TO PACK AS GROUPA. -C THEREFORE, TRY TO ADD INC POINTS TO GROUP A WITHOUT INCREASING -C IBITA. THIS AUGMENTED GROUP IS CALLED GROUP C. -C -C ************************************* -C - 180 IF(MISLLA.EQ.1)THEN - MINC=MALLOW - MINCK=MALLOW - MAXC=-MALLOW - MAXCK=-MALLOW - ELSE - MINC=MINA - MAXC=MAXA - MINCK=MINAK - MAXCK=MINAK - ENDIF -C - NOUNT=0 - IF(NXY-(KTOTAL+KINC).LE.LMINPK/2)KINC=NXY-KTOTAL -C ABOVE STATEMENT CONSTRAINS THE LAST GROUP TO BE NOT LESS THAN -C LMINPK/2 IN SIZE. IF A PROVISION LIKE THIS IS NOT INCLUDED, -C THERE WILL MANY TIMES BE A VERY SMALL GROUP AT THE END. -C -C USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES -C FOR EFFICIENCY. SINCE KINC IS USUALLY 1, USING SEPARATE -C LOOPS HERE DOESN'T BUY MUCH. A MISSING VALUE WILL ALWAYS -C TRANSFER BACK TO GROUP A. -C - IF(IS523.EQ.0)THEN -C - DO 185 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY) - IF(IC(K).LT.MINC)THEN - MINC=IC(K) - MINCK=K - ENDIF - IF(IC(K).GT.MAXC)THEN - MAXC=IC(K) - MAXCK=K - ENDIF - NOUNT=NOUNT+1 - 185 CONTINUE -C - ELSEIF(IS523.EQ.1)THEN -C - DO 187 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY) - IF(IC(K).EQ.MISSP)GO TO 186 - IF(IC(K).LT.MINC)THEN - MINC=IC(K) - MINCK=K - ENDIF - IF(IC(K).GT.MAXC)THEN - MAXC=IC(K) - MAXCK=K - ENDIF - 186 NOUNT=NOUNT+1 - 187 CONTINUE -C - ELSE -C - DO 190 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY) - IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 189 - IF(IC(K).LT.MINC)THEN - MINC=IC(K) - MINCK=K - ENDIF - IF(IC(K).GT.MAXC)THEN - MAXC=IC(K) - MAXCK=K - ENDIF - 189 NOUNT=NOUNT+1 - 190 CONTINUE -C - ENDIF -C -C***D WRITE(KFILDO,191)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA, -C***D 1 MINC,MAXC,NOUNT,IC(KTOTAL),IC(KTOTAL+1) -C***D191 FORMAT(' AT 191, KOUNTA ='I8,' KTOTAL ='I8,' MINA ='I8, -C***D 1 ' MAXA ='I8,' IBITA ='I3,' MISLLA ='I3, -C***D 2 ' MINC ='I8,' MAXC ='I8, -C***D 3 ' NOUNT ='I5,' IC(KTOTAL) ='I9,' IC(KTOTAL+1) =',I9) -C -C IF THE NUMBER OF BITS NEEDED FOR GROUP C IS GT IBITA, -C THEN THIS GROUP A IS A GROUP TO PACK. -C - IF(MINC.EQ.MALLOW)THEN - MINC=MINA - MAXC=MAXA - MINCK=MINAK - MAXCK=MAXAK - MISLLC=1 - GO TO 195 -C WHEN THE NEW VALUE(S) ARE MISSING, THEY CAN ALWAYS -C BE ADDED. -C - ELSE - MISLLC=0 - ENDIF -C - IF(MAXC-MINC.GE.IBXX2(IBITA)-LMISS) GO TO 200 -C -C THE BITS NECESSARY FOR GROUP C HAS NOT INCREASED FROM THE -C BITS NECESSARY FOR GROUP A. ADD THIS POINT(S) TO GROUP A. -C COMPUTE THE NEXT GROUP B, ETC., UNLESS ALL POINTS HAVE BEEN -C USED. -C - 195 KTOTAL=KTOTAL+NOUNT - KOUNTA=KOUNTA+NOUNT - MINA=MINC - MAXA=MAXC - MINAK=MINCK - MAXAK=MAXCK - MISLLA=MISLLC - ADDA=.TRUE. - IF(KTOTAL.GE.NXY)GO TO 200 -C - IF(MINBK.GT.KTOTAL.AND.MAXBK.GT.KTOTAL)THEN - MSTART=NENDB+1 -C THE MAX AND MIN OF GROUP B WERE NOT FROM THE POINTS -C REMOVED, SO THE WHOLE GROUP DOES NOT HAVE TO BE LOOKED -C AT TO DETERMINE THE NEW MAX AND MIN. RATHER START -C JUST BEYOND THE OLD NENDB. - IBITBS=IBITB - NENDB=1 - GO TO 150 - ELSE - GO TO 140 - ENDIF -C -C ************************************* -C -C GROUP A IS TO BE PACKED. STORE VALUES IN JMIN( ), JMAX( ), -C LBIT( ), AND NOV( ). -C -C ************************************* -C - 200 LX=LX+1 - IF(LX.LE.NDG)GO TO 205 - LMINPK=LMINPK+LMINPK/2 -C WRITE(KFILDO,201)NDG,LMINPK,LX -C201 FORMAT(' ****NDG ='I5,' NOT LARGE ENOUGH.', -C 1 ' LMINPK IS INCREASED TO 'I3,' FOR THIS FIELD.'/ -C 2 ' LX = 'I10) - IERSAV=716 - GO TO 105 -C - 205 JMIN(LX)=MINA - JMAX(LX)=MAXA - LBIT(LX)=IBITA - NOV(LX)=KOUNTA - KSTART=KTOTAL+1 -C - IF(MISLLA.EQ.0)THEN - MISSLX(LX)=MALLOW - ELSE - MISSLX(LX)=IC(KTOTAL) -C IC(KTOTAL) WAS THE LAST VALUE PROCESSED. IF MISLLA NE 0, -C THIS MUST BE THE MISSING VALUE FOR THIS GROUP. - ENDIF -C -C***D WRITE(KFILDO,206)MISLLA,IC(KTOTAL),KTOTAL,LX,JMIN(LX),JMAX(LX), -C***D 1 LBIT(LX),NOV(LX),MISSLX(LX) -C***D206 FORMAT(' AT 206, MISLLA ='I2,' IC(KTOTAL) ='I5,' KTOTAL ='I8, -C***D 1 ' LX ='I6,' JMIN(LX) ='I8,' JMAX(LX) ='I8, -C***D 2 ' LBIT(LX) ='I5,' NOV(LX) ='I8,' MISSLX(LX) =',I7) -C - IF(KTOTAL.GE.NXY)GO TO 209 -C -C THE NEW GROUP A WILL BE THE PREVIOUS GROUP B. SET LIMITS, ETC. -C - IBITA=IBITB - MINA=MINB - MAXA=MAXB - MINAK=MINBK - MAXAK=MAXBK - MISLLA=MISLLB - NENDA=NENDB - KOUNTA=KOUNTB - KTOTAL=KTOTAL+KOUNTA - ADDA=.FALSE. - GO TO 133 -C -C ************************************* -C -C CALCULATE IBIT, THE NUMBER OF BITS NEEDED TO HOLD THE GROUP -C MINIMUM VALUES. -C -C ************************************* -C - 209 IBIT=0 -C - DO 220 L=1,LX - 210 IF(JMIN(L).LT.IBXX2(IBIT))GO TO 220 - IBIT=IBIT+1 - GO TO 210 - 220 CONTINUE -C -C INSERT THE VALUE IN JMIN( ) TO BE USED FOR ALL MISSING -C VALUES WHEN LBIT( ) = 0. WHEN SECONDARY MISSING -C VALUES CAN BE PRESENT, LBIT(L) WILL NOT = 0. -C - IF(IS523.EQ.1)THEN -C - DO 226 L=1,LX -C - IF(LBIT(L).EQ.0)THEN -C - IF(MISSLX(L).EQ.MISSP)THEN - JMIN(L)=IBXX2(IBIT)-1 - ENDIF -C - ENDIF -C - 226 CONTINUE -C - ENDIF -C -C ************************************* -C -C CALCULATE JBIT, THE NUMBER OF BITS NEEDED TO HOLD THE BITS -C NEEDED TO PACK THE VALUES IN THE GROUPS. BUT FIND AND -C REMOVE THE REFERENCE VALUE FIRST. -C -C ************************************* -C -C WRITE(KFILDO,228)CFEED,LX -C228 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP WIDTHS LBIT( ) FOR ',I8,' GROUPS' -C 2 /' *****************************************') -C WRITE(KFILDO,229) (LBIT(J),J=1,MIN(LX,100)) -C229 FORMAT(/' '20I6) -C - LBITREF=LBIT(1) -C - DO 230 K=1,LX - IF(LBIT(K).LT.LBITREF)LBITREF=LBIT(K) - 230 CONTINUE -C - IF(LBITREF.NE.0)THEN -C - DO 240 K=1,LX - LBIT(K)=LBIT(K)-LBITREF - 240 CONTINUE -C - ENDIF -C -C WRITE(KFILDO,241)CFEED,LBITREF -C241 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP WIDTHS LBIT( ) AFTER REMOVING REFERENCE ', -C 2 I8, -C 3 /' *****************************************') -C WRITE(KFILDO,242) (LBIT(J),J=1,MIN(LX,100)) -C242 FORMAT(/' '20I6) -C - JBIT=0 -C - DO 320 K=1,LX - 310 IF(LBIT(K).LT.IBXX2(JBIT))GO TO 320 - JBIT=JBIT+1 - GO TO 310 - 320 CONTINUE -C -C ************************************* -C -C CALCULATE KBIT, THE NUMBER OF BITS NEEDED TO HOLD THE NUMBER -C OF VALUES IN THE GROUPS. BUT FIND AND REMOVE THE -C REFERENCE FIRST. -C -C ************************************* -C -C WRITE(KFILDO,321)CFEED,LX -C321 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP SIZES NOV( ) FOR ',I8,' GROUPS' -C 2 /' *****************************************') -C WRITE(KFILDO,322) (NOV(J),J=1,MIN(LX,100)) -C322 FORMAT(/' '20I6) -C - NOVREF=NOV(1) -C - DO 400 K=1,LX - IF(NOV(K).LT.NOVREF)NOVREF=NOV(K) - 400 CONTINUE -C - IF(NOVREF.GT.0)THEN -C - DO 405 K=1,LX - NOV(K)=NOV(K)-NOVREF - 405 CONTINUE -C - ENDIF -C -C WRITE(KFILDO,406)CFEED,NOVREF -C406 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP SIZES NOV( ) AFTER REMOVING REFERENCE ',I8, -C 2 /' *****************************************') -C WRITE(KFILDO,407) (NOV(J),J=1,MIN(LX,100)) -C407 FORMAT(/' '20I6) -C WRITE(KFILDO,408)CFEED -C408 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP REFERENCES JMIN( )' -C 2 /' *****************************************') -C WRITE(KFILDO,409) (JMIN(J),J=1,MIN(LX,100)) -C409 FORMAT(/' '20I6) -C - KBIT=0 -C - DO 420 K=1,LX - 410 IF(NOV(K).LT.IBXX2(KBIT))GO TO 420 - KBIT=KBIT+1 - GO TO 410 - 420 CONTINUE -C -C DETERMINE WHETHER THE GROUP SIZES SHOULD BE REDUCED -C FOR SPACE EFFICIENCY. -C - IF(IRED.EQ.0)THEN - CALL REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT, - 1 NOVREF,IBXX2,IER) -C - IF(IER.EQ.714.OR.IER.EQ.715)THEN -C REDUCE HAS ABORTED. REEXECUTE PACK_GP WITHOUT REDUCE. -C PROVIDE FOR A NON FATAL RETURN FROM REDUCE. - IERSAV=IER - IRED=1 - IER=0 - GO TO 102 - ENDIF -C - ENDIF -C -C CALL TIMPR(KFILDO,KFILDO,'END PACK_GP ') - IF(IERSAV.NE.0)THEN - IER=IERSAV - RETURN - ENDIF -C -C 900 IF(IER.NE.0)RETURN1 -C - 900 RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params.f deleted file mode 100755 index e4d775f3f2..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params.f +++ /dev/null @@ -1,935 +0,0 @@ - module params -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! MODULE: params -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-05 -! -! ABSTRACT: This Fortran Module contains info on all the available -! GRIB Parameters. -! -! PROGRAM HISTORY LOG: -! 2000-05-11 Gilbert -! 2003-08-07 Gilbert - Added more parameters -! 2003-09-26 Gilbert - Added more parameters -! 2005-11-17 Gordon - Added more parameters for the Wave & Smoke models -! 2007-03-28 Vuong - Added more parameters -! 2007-10-10 Vuong - Added more parameters -! 2008-03-12 Vuong - Added more parameters -! 2008-06-30 Vuong - Reformat entry paramlist from 1 to 173 -! Added more parameters and entire table 131 -! 2008-11-21 Vuong - Added more parameters -! -! USAGE: use params -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,parameter :: MAXPARAM=719 - - type gribparam - integer :: g1tblver - integer :: grib1val - integer :: grib2dsc - integer :: grib2cat - integer :: grib2num - character(len=8) :: abbrev - end type gribparam - - type(gribparam),dimension(MAXPARAM) :: paramlist - - data paramlist(1) /gribparam(2,1,0,3,0,'PRES')/ - data paramlist(2) /gribparam(2,2,0,3,1,'PRMSL')/ - data paramlist(3) /gribparam(2,3,0,3,2,'PTEND')/ - data paramlist(4) /gribparam(2,4,0,2,14,'PVORT')/ - data paramlist(5) /gribparam(2,5,0,3,3,'ICAHT')/ - data paramlist(6) /gribparam(2,6,0,3,4,'GP')/ - data paramlist(7) /gribparam(2,7,0,3,5,'HGT')/ - data paramlist(8) /gribparam(2,8,0,3,6,'DIST')/ - data paramlist(9) /gribparam(2,9,0,3,7,'HSTDV')/ - data paramlist(10) /gribparam(2,10,0,14,0,'TOZNE')/ - data paramlist(11) /gribparam(2,11,0,0,0,'TMP')/ - data paramlist(12) /gribparam(2,12,0,0,1,'VTMP')/ - data paramlist(13) /gribparam(2,13,0,0,2,'POT')/ - data paramlist(14) /gribparam(2,14,0,0,3,'EPOT')/ - data paramlist(15) /gribparam(2,15,0,0,4,'TMAX')/ - data paramlist(16) /gribparam(2,16,0,0,5,'TMIN')/ - data paramlist(17) /gribparam(2,17,0,0,6,'DPT')/ - data paramlist(18) /gribparam(2,18,0,0,7,'DEPR')/ - data paramlist(19) /gribparam(2,19,0,0,8,'LAPR')/ - data paramlist(20) /gribparam(2,20,0,19,0,'VIS')/ - data paramlist(21) /gribparam(2,21,0,15,6,'RDSP1')/ - data paramlist(22) /gribparam(2,22,0,15,7,'RDSP2')/ - data paramlist(23) /gribparam(2,23,0,15,8,'RDSP3')/ - data paramlist(24) /gribparam(2,24,0,7,0,'PLI')/ - data paramlist(25) /gribparam(2,25,0,0,9,'TMP A')/ - data paramlist(26) /gribparam(2,26,0,3,8,'PRESA')/ - data paramlist(27) /gribparam(2,27,0,3,9,'GP A')/ - data paramlist(28) /gribparam(2,28,10,0,0,'WVSP1')/ - data paramlist(29) /gribparam(2,29,10,0,1,'WVSP2')/ - data paramlist(30) /gribparam(2,30,10,0,2,'WVSP3')/ - data paramlist(31) /gribparam(2,31,0,2,0,'WDIR')/ - data paramlist(32) /gribparam(2,32,0,2,1,'WIND')/ - data paramlist(33) /gribparam(2,33,0,2,2,'U GRD')/ - data paramlist(34) /gribparam(2,34,0,2,3,'V GRD')/ - data paramlist(35) /gribparam(2,35,0,2,4,'STRM')/ - data paramlist(36) /gribparam(2,36,0,2,5,'VPOT')/ - data paramlist(37) /gribparam(2,37,0,2,6,'MNTSF')/ - data paramlist(38) /gribparam(2,38,0,2,7,'SGCVV')/ - data paramlist(39) /gribparam(2,39,0,2,8,'V VEL')/ - data paramlist(40) /gribparam(2,40,0,2,9,'DZDT')/ - data paramlist(41) /gribparam(2,41,0,2,10,'ABS V')/ - data paramlist(42) /gribparam(2,42,0,2,11,'ABS D')/ - data paramlist(43) /gribparam(2,43,0,2,12,'REL V')/ - data paramlist(44) /gribparam(2,44,0,2,13,'REL D')/ - data paramlist(45) /gribparam(2,45,0,2,15,'VUCSH')/ - data paramlist(46) /gribparam(2,46,0,2,16,'VVCSH')/ - data paramlist(47) /gribparam(2,47,10,1,0,'DIR C')/ - data paramlist(48) /gribparam(2,48,10,1,1,'SP C')/ - data paramlist(49) /gribparam(2,49,10,1,2,'UOGRD')/ - data paramlist(50) /gribparam(2,50,10,1,3,'VOGRD')/ - data paramlist(51) /gribparam(2,51,0,1,0,'SPF H')/ - data paramlist(52) /gribparam(2,52,0,1,1,'R H')/ - data paramlist(53) /gribparam(2,53,0,1,2,'MIXR')/ - data paramlist(54) /gribparam(2,54,0,1,3,'P WAT')/ - data paramlist(55) /gribparam(2,55,0,1,4,'VAPP')/ - data paramlist(56) /gribparam(2,56,0,1,5,'SAT D')/ - data paramlist(57) /gribparam(2,57,0,1,6,'EVP')/ - data paramlist(58) /gribparam(2,58,0,6,0,'C ICE')/ - data paramlist(59) /gribparam(2,59,0,1,7,'PRATE')/ - data paramlist(60) /gribparam(2,60,0,19,2,'TSTM')/ - data paramlist(61) /gribparam(2,61,0,1,8,'A PCP')/ - data paramlist(62) /gribparam(2,62,0,1,9,'NCPCP')/ - data paramlist(63) /gribparam(2,63,0,1,10,'ACPCP')/ - data paramlist(64) /gribparam(2,64,0,1,12,'SRWEQ')/ - data paramlist(65) /gribparam(2,65,0,1,13,'WEASD')/ - data paramlist(66) /gribparam(2,66,0,1,11,'SNO D')/ - data paramlist(67) /gribparam(2,67,0,19,3,'MIXHT')/ - data paramlist(68) /gribparam(2,68,10,4,2,'TTHDP')/ - data paramlist(69) /gribparam(2,69,10,4,0,'MTHD')/ - data paramlist(70) /gribparam(2,70,10,4,1,'MTH A')/ - data paramlist(71) /gribparam(2,71,0,6,1,'T CDC')/ - data paramlist(72) /gribparam(2,72,0,6,2,'CDCON')/ - data paramlist(73) /gribparam(2,73,0,6,3,'L CDC')/ - data paramlist(74) /gribparam(2,74,0,6,4,'M CDC')/ - data paramlist(75) /gribparam(2,75,0,6,5,'H CDC')/ - data paramlist(76) /gribparam(2,76,0,6,6,'C WAT')/ - data paramlist(77) /gribparam(2,77,0,7,1,'BLI')/ - data paramlist(78) /gribparam(2,78,0,1,14,'SNO C')/ - data paramlist(79) /gribparam(2,79,0,1,15,'SNO L')/ - data paramlist(80) /gribparam(2,80,10,3,0,'WTMP')/ - data paramlist(81) /gribparam(2,81,2,0,0,'LAND')/ - data paramlist(82) /gribparam(2,82,10,3,1,'DSL M')/ - data paramlist(83) /gribparam(2,83,2,0,1,'SFC R')/ - data paramlist(84) /gribparam(2,84,0,19,1,'ALBDO')/ - data paramlist(85) /gribparam(2,85,2,0,2,'TSOIL')/ - data paramlist(86) /gribparam(2,86,2,0,3,'SOIL M')/ - data paramlist(87) /gribparam(2,87,2,0,4,'VEG')/ - data paramlist(88) /gribparam(2,88,10,4,3,'SALTY')/ - data paramlist(89) /gribparam(2,89,0,3,10,'DEN')/ - data paramlist(90) /gribparam(2,90,2,0,5,'WATR')/ - data paramlist(91) /gribparam(2,91,10,2,0,'ICE C')/ - data paramlist(92) /gribparam(2,92,10,2,1,'ICETK')/ - data paramlist(93) /gribparam(2,93,10,2,2,'DICED')/ - data paramlist(94) /gribparam(2,94,10,2,3,'SICED')/ - data paramlist(95) /gribparam(2,95,10,2,4,'U ICE')/ - data paramlist(96) /gribparam(2,96,10,2,5,'V ICE')/ - data paramlist(97) /gribparam(2,97,10,2,6,'ICE G')/ - data paramlist(98) /gribparam(2,98,10,2,7,'ICE D')/ - data paramlist(99) /gribparam(2,99,0,1,16,'SNO M')/ - data paramlist(100) /gribparam(2,100,10,0,3,'HTSGW')/ - data paramlist(101) /gribparam(2,101,10,0,4,'WVDIR')/ - data paramlist(102) /gribparam(2,102,10,0,5,'WVHGT')/ - data paramlist(103) /gribparam(2,103,10,0,6,'WVPER')/ - data paramlist(104) /gribparam(2,104,10,0,7,'SWDIR')/ - data paramlist(105) /gribparam(2,105,10,0,8,'SWELL')/ - data paramlist(106) /gribparam(2,106,10,0,9,'SWPER')/ - data paramlist(107) /gribparam(2,107,10,0,10,'DIRPW')/ - data paramlist(108) /gribparam(2,108,10,0,11,'PERPW')/ - data paramlist(109) /gribparam(2,109,10,0,12,'DIRSW')/ - data paramlist(110) /gribparam(2,110,10,0,13,'PERSW')/ - data paramlist(111) /gribparam(2,111,0,4,0,'NSWRS')/ - data paramlist(112) /gribparam(2,112,0,5,0,'NLWRS')/ - data paramlist(113) /gribparam(2,113,0,4,1,'NSWRT')/ - data paramlist(114) /gribparam(2,114,0,5,1,'NLWRT')/ - data paramlist(115) /gribparam(2,115,0,5,2,'LWAVR')/ - data paramlist(116) /gribparam(2,116,0,4,2,'SWAVR')/ - data paramlist(117) /gribparam(2,117,0,4,3,'G RAD')/ - data paramlist(118) /gribparam(2,118,0,4,4,'BRTMP')/ - data paramlist(119) /gribparam(2,119,0,4,5,'LWRAD')/ - data paramlist(120) /gribparam(2,120,0,4,6,'SWRAD')/ - data paramlist(121) /gribparam(2,121,0,0,10,'LHTFL')/ - data paramlist(122) /gribparam(2,122,0,0,11,'SHTFL')/ - data paramlist(123) /gribparam(2,123,0,2,20,'BLYDP')/ - data paramlist(124) /gribparam(2,124,0,2,17,'UFLX')/ - data paramlist(125) /gribparam(2,125,0,2,18,'VFLX')/ - data paramlist(126) /gribparam(2,126,0,2,19,'WMIXE')/ - data paramlist(127) /gribparam(2,127,255,255,255,'IMGD')/ -! -! GRIB1 parameters in NCEP Local Table version 2 -! Added 8/07/2003 -! - data paramlist(128) /gribparam(2,229,0,0,192,'SNOHF')/ - data paramlist(129) /gribparam(2,153,0,1,22,'CLWMR')/ - data paramlist(130) /gribparam(2,140,0,1,192,'CRAIN')/ - data paramlist(131) /gribparam(2,141,0,1,193,'CFRZR')/ - data paramlist(132) /gribparam(2,142,0,1,194,'CICEP')/ - data paramlist(133) /gribparam(2,143,0,1,195,'CSNOW')/ - data paramlist(134) /gribparam(2,214,0,1,196,'CPRAT')/ - data paramlist(135) /gribparam(2,135,0,1,197,'MCONV')/ - data paramlist(136) /gribparam(2,194,1,1,193,'CPOFP')/ - data paramlist(137) /gribparam(2,228,0,1,199,'PEVAP')/ - data paramlist(138) /gribparam(2,136,0,2,192,'VW SH')/ - data paramlist(139) /gribparam(2,172,0,2,193,'MFLX')/ - data paramlist(140) /gribparam(2,196,0,2,194,'USTM')/ - data paramlist(141) /gribparam(2,197,0,2,195,'VSTM')/ - data paramlist(142) /gribparam(2,252,0,2,196,'CD')/ - data paramlist(143) /gribparam(2,253,0,2,197,'FRICV')/ - data paramlist(144) /gribparam(2,130,0,3,192,'MSLET')/ - data paramlist(145) /gribparam(2,204,0,4,192,'DSWRF')/ - data paramlist(146) /gribparam(2,211,0,4,193,'USWRF')/ - data paramlist(147) /gribparam(2,205,0,5,192,'DLWRF')/ - data paramlist(148) /gribparam(2,212,0,5,193,'ULWRF')/ - data paramlist(149) /gribparam(2,213,0,6,192,'CDLYR')/ - data paramlist(150) /gribparam(2,132,0,7,193,'4LFTX')/ - data paramlist(151) /gribparam(2,157,0,7,6,'CAPE')/ - data paramlist(152) /gribparam(2,156,0,7,7,'CIN')/ - data paramlist(153) /gribparam(2,190,0,7,8,'HLCY')/ - data paramlist(154) /gribparam(2,131,0,7,192,'LFT X')/ - data paramlist(155) /gribparam(2,158,0,19,11,'TKE')/ - data paramlist(156) /gribparam(2,176,0,191,192,'NLAT')/ - data paramlist(157) /gribparam(2,177,0,191,193,'ELON')/ - data paramlist(158) /gribparam(2,234,1,0,192,'BGRUN')/ - data paramlist(159) /gribparam(2,235,1,0,193,'SSRUN')/ - data paramlist(160) /gribparam(2,144,2,0,192,'SOILW')/ - data paramlist(161) /gribparam(2,155,2,0,193,'GFLUX')/ - data paramlist(162) /gribparam(2,207,2,0,194,'MSTAV')/ - data paramlist(163) /gribparam(2,208,2,0,195,'SFEXC')/ - data paramlist(164) /gribparam(2,223,2,0,196,'CNWAT')/ - data paramlist(165) /gribparam(2,226,2,0,197,'BMIXL')/ - data paramlist(166) /gribparam(2,154,0,14,192,'O3MR')/ - data paramlist(167) /gribparam(2,222,0,3,193,'5WAVH')/ - data paramlist(168) /gribparam(2,145,0,1,200,'PEVPR')/ - data paramlist(169) /gribparam(2,146,0,6,193,'CWORK')/ - data paramlist(170) /gribparam(2,147,0,3,194,'U-GWD')/ - data paramlist(171) /gribparam(2,148,0,3,195,'V-GWD')/ - data paramlist(172) /gribparam(2,221,0,3,196,'HPBL')/ - data paramlist(173) /gribparam(2,230,0,3,197,'5WAVA')/ -! Added 9/26/2003 - data paramlist(174) /gribparam(130,160,2,3,192,'SOILL ')/ - data paramlist(175) /gribparam(130,171,2,3,193,'RLYRS ')/ - data paramlist(176) /gribparam(130,219,2,0,201,'WILT ')/ - data paramlist(177) /gribparam(130,222,2,3,194,'SLTYP ')/ - data paramlist(178) /gribparam(2,224,2,3,0,'SOTYP ')/ - data paramlist(179) /gribparam(2,225,2,0,198,'VGTYP ')/ - data paramlist(180) /gribparam(130,230,2,3,195,'SMREF ')/ - data paramlist(181) /gribparam(130,231,2,3,196,'SMDRY ')/ - data paramlist(182) /gribparam(2,238,0,1,201,'SNOWC ')/ - data paramlist(183) /gribparam(130,240,2,3,197,'POROS ')/ - data paramlist(184) /gribparam(129,131,0,1,202,'FRAIN ')/ - data paramlist(185) /gribparam(129,132,0,6,199,'FICE ')/ - data paramlist(186) /gribparam(129,133,0,1,203,'FRIME ')/ - data paramlist(187) /gribparam(129,134,0,6,194,'CUEFI ')/ - data paramlist(188) /gribparam(129,135,0,6,195,'TCOND ')/ - data paramlist(189) /gribparam(129,136,0,6,196,'TCOLW ')/ - data paramlist(190) /gribparam(129,137,0,6,197,'TCOLI ')/ - data paramlist(191) /gribparam(129,138,0,1,204,'TCOLR ')/ - data paramlist(192) /gribparam(129,139,0,1,205,'TCOLS ')/ - data paramlist(193) /gribparam(129,140,0,6,198,'TCOLC ')/ - data paramlist(194) /gribparam(130,159,0,19,192,'MXSALB ')/ - data paramlist(195) /gribparam(130,170,0,19,193,'SNFALB ')/ - data paramlist(196) /gribparam(2,170,0,1,24,'RWMR ')/ - data paramlist(197) /gribparam(2,171,0,1,25,'SNMR ')/ - data paramlist(198) /gribparam(130,181,2,0,199,'CCOND ')/ - data paramlist(199) /gribparam(130,203,2,0,200,'RSMIN ')/ - data paramlist(200) /gribparam(130,246,2,0,202,'RCS ')/ - data paramlist(201) /gribparam(130,247,2,0,203,'RCT ')/ - data paramlist(202) /gribparam(130,248,2,0,204,'RCQ ')/ - data paramlist(203) /gribparam(130,249,2,0,205,'RCSOL ')/ - data paramlist(204) /gribparam(2,254,0,7,194,'RI ')/ - data paramlist(205) /gribparam(129,190,3,1,192,'USCT ')/ - data paramlist(206) /gribparam(129,191,3,1,193,'VSCT ')/ - data paramlist(207) /gribparam(129,171,0,191,194,'TSEC ')/ - data paramlist(208) /gribparam(129,180,0,14,193,'OZCON ')/ - data paramlist(209) /gribparam(129,181,0,14,194,'OZCAT ')/ - data paramlist(210) /gribparam(2,193,1,1,2,'POP ')/ - data paramlist(211) /gribparam(2,195,1,1,192,'CPOZP ')/ - data paramlist(212) /gribparam(2,180,0,2,22,'GUST ')/ -! Added 11/17/2005 - for wave models - data paramlist(213) /gribparam(0,31,0,2,0,'WDIR ')/ - data paramlist(214) /gribparam(0,32,0,2,1,'WIND ')/ - data paramlist(215) /gribparam(0,33,0,2,2,'U GRD ')/ - data paramlist(216) /gribparam(0,34,0,2,3,'V GRD ')/ - data paramlist(217) /gribparam(0,100,10,0,3,'HTSGW ')/ - data paramlist(218) /gribparam(0,101,10,0,4,'WVDIR ')/ - data paramlist(219) /gribparam(0,103,10,0,6,'WVPER ')/ - data paramlist(220) /gribparam(0,107,10,0,10,'DIRPW ')/ - data paramlist(221) /gribparam(0,108,10,0,11,'PERPW ')/ - data paramlist(222) /gribparam(0,109,10,0,12,'DIRSW ')/ - data paramlist(223) /gribparam(0,110,10,0,13,'PERSW ')/ -! Added 1/26/2006 - - data paramlist(224) /gribparam(129,156,0,13,192,'PMTC ')/ - data paramlist(225) /gribparam(129,157,0,13,193,'PMTF ')/ - data paramlist(226) /gribparam(3,11,0,0,0,'TMP ')/ - data paramlist(227) /gribparam(2,129,0,3,198,'MSLMA ')/ - data paramlist(228) /gribparam(129,163,0,13,194,'LPMTF ')/ - data paramlist(229) /gribparam(129,164,0,13,195,'LIPMF ')/ -! Added 3/6/2006 - For missing GRIB1 to GRIB2 conversions - data paramlist(230) /gribparam(2,178,0,1,23,'ICMR ')/ - data paramlist(231) /gribparam(2,179,0,1,32,'GRMR ')/ - data paramlist(232) /gribparam(2,186,0,1,206,'TIPD ')/ - data paramlist(233) /gribparam(2,187,0,17,192,'LTNG ')/ - data paramlist(234) /gribparam(2,188,2,0,206,'RDRIP ')/ - data paramlist(235) /gribparam(2,189,0,0,15,'VPTMP ')/ - data paramlist(236) /gribparam(2,198,0,1,207,'NCIP ')/ - data paramlist(237) /gribparam(2,239,0,1,208,'SNOT ')/ - data paramlist(238) /gribparam(2,128,0,3,1,'MSLSA ')/ - data paramlist(239) /gribparam(2,137,0,3,199,'TSLSA ')/ - data paramlist(240) /gribparam(129,141,0,3,200,'PLPL ')/ - data paramlist(241) /gribparam(129,200,0,4,194,'DUVB ')/ - data paramlist(242) /gribparam(129,201,0,4,195,'CDUVB ')/ - data paramlist(243) /gribparam(2,201,2,0,207,'ICWAT ')/ - data paramlist(244) /gribparam(2,209,0,19,204,'MIXLY ')/ - data paramlist(245) /gribparam(2,216,0,0,193,'TTRAD ')/ - data paramlist(246) /gribparam(129,211,0,16,195,'REFD ')/ - data paramlist(247) /gribparam(129,212,0,16,196,'REFC ')/ - data paramlist(248) /gribparam(2,161,0,4,196,'CSDSF ')/ - data paramlist(249) /gribparam(129,168,0,1,209,'TCLSW ')/ - data paramlist(250) /gribparam(129,169,0,1,210,'TCOLM ')/ - data paramlist(251) /gribparam(2,181,0,3,201,'LPS X ')/ - data paramlist(252) /gribparam(2,182,0,3,202,'LPS Y ')/ - data paramlist(253) /gribparam(2,183,0,3,203,'HGT X ')/ - data paramlist(254) /gribparam(2,184,0,3,204,'HGT Y ')/ - data paramlist(255) /gribparam(128,254,0,0,194,'REV ')/ -! Added 4/20/2007 - For missing GRIB1 to GRIB2 conversions - data paramlist(256) /gribparam(1,91,10,2,0,'ICE C ')/ - data paramlist(257) /gribparam(0,49,10,1,2,'UOGRD ')/ - data paramlist(258) /gribparam(0,50,10,1,3,'VOGRD ')/ - data paramlist(259) /gribparam(0,80,10,3,0,'WTMP ')/ - data paramlist(260) /gribparam(0,82,10,3,1,'DSL M ')/ - data paramlist(261) /gribparam(0,88,10,4,3,'SALTY ')/ - data paramlist(262) /gribparam(1,49,10,1,2,'UOGRD ')/ - data paramlist(263) /gribparam(1,50,10,1,3,'VOGRD ')/ - data paramlist(264) /gribparam(1,80,10,3,0,'WTMP ')/ - data paramlist(265) /gribparam(1,88,10,4,3,'SALTY ')/ - data paramlist(266) /gribparam(1,40,0,2,9,'DZDT ')/ - data paramlist(267) /gribparam(1,67,0,19,3,'MIXHT ')/ - data paramlist(268) /gribparam(3,2,0,3,1,'PRMSL ')/ - data paramlist(269) /gribparam(3,7,0,3,5,'HGT ')/ - data paramlist(270) /gribparam(128,130,10,3,194,'ELEV ')/ - data paramlist(271) /gribparam(129,217,0,1,198,'MINRH ')/ - data paramlist(272) /gribparam(129,218,0,1,27,'MAXRH ')/ - data paramlist(273) /gribparam(130,161,0,1,29,'ASNOW ')/ - data paramlist(274) /gribparam(129,165,0,16,192,'REFZR ')/ - data paramlist(275) /gribparam(129,166,0,16,193,'REFZI ')/ - data paramlist(276) /gribparam(129,167,0,16,194,'REFZC ')/ - data paramlist(277) /gribparam(129,192,0,2,198,'LAUV ')/ - data paramlist(278) /gribparam(129,193,0,2,199,'LOUV ')/ - data paramlist(279) /gribparam(129,188,0,2,200,'LAVV ')/ - data paramlist(280) /gribparam(129,189,0,2,201,'LOVV ')/ - data paramlist(281) /gribparam(129,207,0,2,202,'LAPP ')/ - data paramlist(282) /gribparam(129,208,0,2,203,'LOPP ')/ - data paramlist(283) /gribparam(129,198,10,3,195,'SSHG ')/ - data paramlist(284) /gribparam(1,33,0,2,2,'U GRD ')/ - data paramlist(285) /gribparam(1,34,0,2,3,'V GRD ')/ - data paramlist(286) /gribparam(1,2,0,3,1,'PRMSL ')/ - data paramlist(287) /gribparam(1,7,0,3,5,'HGT ')/ - data paramlist(288) /gribparam(128,186,10,4,192,'WTMPC ')/ - data paramlist(289) /gribparam(128,187,10,4,193,'SALIN ')/ - data paramlist(290) /gribparam(128,177,10,3,196,'P2OMLT ')/ - data paramlist(291) /gribparam(128,178,10,1,192,'OMLU ')/ - data paramlist(292) /gribparam(128,179,10,1,193,'OMLV ')/ - data paramlist(293) /gribparam(128,183,10,1,194,'UBARO ')/ - data paramlist(294) /gribparam(128,184,10,1,195,'VBARO ')/ - data paramlist(295) /gribparam(129,179,0,19,205,'FLGHT ')/ - data paramlist(296) /gribparam(129,185,0,19,206,'CICEL ')/ - data paramlist(297) /gribparam(129,186,0,19,207,'CIVIS ')/ - data paramlist(298) /gribparam(129,187,0,19,208,'CIFLT ')/ - data paramlist(299) /gribparam(129,177,0,19,209,'LAVNI ')/ - data paramlist(300) /gribparam(129,178,0,19,210,'HAVNI ')/ - data paramlist(301) /gribparam(130,189,0,19,211,'SBSALB ')/ - data paramlist(302) /gribparam(130,190,0,19,212,'SWSALB ')/ - data paramlist(303) /gribparam(130,191,0,19,213,'NBSALB ')/ - data paramlist(304) /gribparam(130,192,0,19,214,'NWSALB ')/ - data paramlist(305) /gribparam(129,149,10,0,192,'WSTP ')/ - data paramlist(306) /gribparam(128,188,0,1,211,'EMNP ')/ - data paramlist(307) /gribparam(128,192,0,3,205,'LAYTH ')/ - data paramlist(308) /gribparam(129,219,0,6,13,'CEIL ')/ - data paramlist(309) /gribparam(129,220,0,19,12,'PBLREG ')/ - data paramlist(310) /gribparam(130,179,2,0,210,'ACOND ')/ - data paramlist(311) /gribparam(130,198,0,1,212,'SBSNO ')/ - data paramlist(312) /gribparam(2,199,2,3,198,'EVBS ')/ - data paramlist(313) /gribparam(2,200,2,0,208,'EVCW ')/ - data paramlist(314) /gribparam(2,210,2,0,209,'TRANS ')/ - data paramlist(315) /gribparam(129,182,0,2,204,'VEDH ')/ - data paramlist(320) /gribparam(2,241,0,0,195,'LRGHR ')/ - data paramlist(321) /gribparam(2,242,0,0,196,'CNVHR ')/ - data paramlist(322) /gribparam(140,168,0,19,217,'MEIP ')/ - data paramlist(323) /gribparam(140,169,0,19,218,'MAIP ')/ - data paramlist(324) /gribparam(140,170,0,19,219,'MECTP ')/ - data paramlist(325) /gribparam(140,171,0,19,220,'MACTP ')/ - data paramlist(326) /gribparam(140,172,0,19,221,'MECAT ')/ - data paramlist(327) /gribparam(140,173,0,19,222,'MACAT ')/ - data paramlist(328) /gribparam(140,174,0,19,223,'CBHE ')/ - data paramlist(329) /gribparam(140,175,0,19,224,'PCBB ')/ - data paramlist(330) /gribparam(140,176,0,19,225,'PCBT ')/ - data paramlist(331) /gribparam(140,177,0,19,226,'PECBB ')/ - data paramlist(332) /gribparam(140,178,0,19,227,'PECBT ')/ - data paramlist(333) /gribparam(140,179,0,19,228,'HCBB ')/ - data paramlist(334) /gribparam(140,180,0,19,229,'HCBT ')/ - data paramlist(335) /gribparam(140,181,0,19,230,'HECBB ')/ - data paramlist(336) /gribparam(140,182,0,19,231,'HECBT ')/ - data paramlist(337) /gribparam(129,76,0,6,6,'C WAT ')/ -! Added 8/24/2007 - data paramlist(338) /gribparam(0,104,10,0,7,'SWDIR ')/ - data paramlist(339) /gribparam(0,105,10,0,8,'SWELL ')/ - data paramlist(340) /gribparam(0,106,10,0,9,'SWPER ')/ - data paramlist(341) /gribparam(0,102,10,0,5,'WVHGT ')/ - data paramlist(342) /gribparam(129,213,3,192,0,'SBT122 ')/ - data paramlist(343) /gribparam(129,214,3,192,1,'SBT123 ')/ - data paramlist(344) /gribparam(129,215,3,192,2,'SBT124 ')/ - data paramlist(345) /gribparam(129,216,3,192,3,'SBT125 ')/ - data paramlist(346) /gribparam(129,221,3,192,4,'SBC123 ')/ - data paramlist(347) /gribparam(129,222,3,192,5,'SBC124 ')/ - data paramlist(348) /gribparam(129,228,10,3,192,'SURGE ')/ - data paramlist(349) /gribparam(129,229,10,3,193,'ETSRG ')/ - data paramlist(350) /gribparam(2,149,0,2,14,'PVORT ')/ - data paramlist(351) /gribparam(2,150,0,192,1,'COVMZ ')/ - data paramlist(352) /gribparam(2,151,0,192,2,'COVTZ ')/ - data paramlist(353) /gribparam(2,152,0,192,3,'COVTM ')/ - data paramlist(354) /gribparam(129,202,0,0,197,'THFLX ')/ - data paramlist(355) /gribparam(3,33,0,2,2,'U GRD ')/ - data paramlist(356) /gribparam(3,34,0,2,3,'V GRD ')/ - data paramlist(357) /gribparam(3,40,0,2,9,'DZDT ')/ - data paramlist(358) /gribparam(3,124,0,2,17,'UFLX ')/ - data paramlist(359) /gribparam(3,125,0,2,18,'VFLX ')/ - data paramlist(360) /gribparam(3,8,0,3,6,'DIST ')/ - data paramlist(361) /gribparam(3,13,0,0,2,'POT ')/ - data paramlist(362) /gribparam(3,88,10,4,3,'SALTY ')/ - data paramlist(363) /gribparam(3,49,10,1,2,'UOGRD ')/ - data paramlist(364) /gribparam(3,50,10,1,3,'VOGRD ')/ - data paramlist(365) /gribparam(2,215,0,0,198,'TTDIA ')/ - data paramlist(366) /gribparam(2,217,0,0,199,'TTPHY ')/ - data paramlist(367) /gribparam(130,154,2,3,199,'LSPA ')/ - data paramlist(368) /gribparam(2,250,0,4,197,'SWHR ')/ - data paramlist(369) /gribparam(2,251,0,5,194,'LWHR ')/ - data paramlist(370) /gribparam(2,160,0,4,198,'CSUSF ')/ - data paramlist(371) /gribparam(2,162,0,5,195,'CSULF ')/ - data paramlist(372) /gribparam(2,163,0,5,196,'CSDLF ')/ - data paramlist(373) /gribparam(2,164,0,4,199,'CFNSF ')/ - data paramlist(374) /gribparam(2,165,0,5,197,'CFNLF ')/ - data paramlist(375) /gribparam(2,166,0,4,200,'VBDSF ')/ - data paramlist(376) /gribparam(2,167,0,4,201,'VDDSF ')/ - data paramlist(377) /gribparam(2,168,0,4,202,'NBDSF ')/ - data paramlist(378) /gribparam(2,169,0,4,203,'NDDSF ')/ - data paramlist(379) /gribparam(2,206,0,7,196,'UVI ')/ - data paramlist(380) /gribparam(2,219,0,0,200,'TSD1D ')/ - data paramlist(381) /gribparam(2,220,0,3,206,'NLGSP ')/ - data paramlist(382) /gribparam(2,244,0,0,201,'SHAHR ')/ - data paramlist(383) /gribparam(2,246,0,0,202,'VDFHR ')/ - data paramlist(384) /gribparam(2,243,0,1,213,'CNVMR ')/ - data paramlist(385) /gribparam(2,245,0,1,214,'SHAMR ')/ - data paramlist(386) /gribparam(2,249,0,1,215,'VDFMR ')/ - data paramlist(387) /gribparam(2,247,0,2,208,'VDFUA ')/ - data paramlist(388) /gribparam(2,248,0,2,209,'VDFVA ')/ - data paramlist(389) /gribparam(3,202,0,7,195,'CWDI ')/ - data paramlist(390) /gribparam(2,232,0,4,204,'DTRF ')/ - data paramlist(391) /gribparam(2,233,0,4,205,'UTRF ')/ - data paramlist(392) /gribparam(2,231,0,6,200,'MFLUX ')/ - data paramlist(393) /gribparam(2,202,0,7,195,'CWDI ')/ - data paramlist(394) /gribparam(2,203,0,19,232,'VAFTD ')/ - data paramlist(395) /gribparam(3,238,0,1,201,'SNOWC ')/ - data paramlist(396) /gribparam(3,66,0,1,11,'SNO D ')/ - data paramlist(397) /gribparam(2,133,0,7,2,'KX ')/ - data paramlist(398) /gribparam(2,134,0,7,5,'SX ')/ - data paramlist(399) /gribparam(128,191,10,4,194,'BKENG ')/ - data paramlist(400) /gribparam(129,195,10,4,195,'DBSS ')/ - data paramlist(401) /gribparam(128,171,10,3,197,'AOHFLX ')/ - data paramlist(402) /gribparam(128,180,10,3,198,'ASHFL ')/ - data paramlist(403) /gribparam(128,193,10,3,199,'SSTT ')/ - data paramlist(404) /gribparam(128,194,10,3,200,'SSST ')/ - data paramlist(405) /gribparam(128,190,10,3,201,'KENG ')/ - data paramlist(406) /gribparam(128,185,10,4,196,'INTFD ')/ - data paramlist(407) /gribparam(129,199,10,3,202,'SLTFL ')/ - data paramlist(408) /gribparam(129,197,10,4,197,'OHC ')/ - data paramlist(409) /gribparam(2,159,0,1,216,'CONP ')/ - data paramlist(410) /gribparam(2,175,0,191,195,'MLYNO ')/ - data paramlist(411) /gribparam(129,223,0,1,65,'RPRATE ')/ - data paramlist(412) /gribparam(129,224,0,1,66,'SPRATE ')/ - data paramlist(413) /gribparam(129,225,0,1,67,'FPRATE ')/ - data paramlist(414) /gribparam(129,226,0,1,68,'IPRATE ')/ - data paramlist(415) /gribparam(129,227,0,7,197,'UPHL ')/ - data paramlist(416) /gribparam(3,87,2,0,4,'VEG ')/ - data paramlist(417) /gribparam(129,130,1,1,195,'CWR ')/ - data paramlist(418) /gribparam(2,240,0,192,4,'COVTW ')/ - data paramlist(419) /gribparam(133,164,0,192,5,'COVZZ ')/ - data paramlist(420) /gribparam(133,165,0,192,6,'COVMM ')/ - data paramlist(421) /gribparam(133,166,0,192,7,'COVQZ ')/ - data paramlist(422) /gribparam(133,167,0,192,8,'COVQM ')/ - data paramlist(423) /gribparam(133,168,0,192,9,'COVTVV ')/ - data paramlist(424) /gribparam(133,169,0,192,10,'COVQVV ')/ - data paramlist(425) /gribparam(133,203,0,192,11,'COVPSPS ')/ - data paramlist(426) /gribparam(133,206,0,192,12,'COVQQ ')/ - data paramlist(427) /gribparam(133,220,0,192,13,'COVVVVV ')/ - data paramlist(428) /gribparam(133,234,0,192,14,'COVTT ')/ - data paramlist(429) /gribparam(133,201,0,0,203,'THZ0 ')/ - data paramlist(430) /gribparam(133,195,0,1,218,'QZ0 ')/ - data paramlist(431) /gribparam(133,204,0,1,219,'QMAX ')/ - data paramlist(432) /gribparam(133,205,0,1,220,'QMIN ')/ - data paramlist(433) /gribparam(133,181,0,2,210,'GWDU ')/ - data paramlist(434) /gribparam(133,182,0,2,211,'GWDV ')/ - data paramlist(435) /gribparam(133,183,0,2,212,'CNVU ')/ - data paramlist(436) /gribparam(133,184,0,2,213,'CNVV ')/ - data paramlist(437) /gribparam(133,236,0,2,214,'WTEND ')/ - data paramlist(438) /gribparam(133,154,0,2,215,'OMGALF ')/ - data paramlist(439) /gribparam(133,196,0,2,216,'CNGWDU ')/ - data paramlist(440) /gribparam(133,197,0,2,217,'CNGWDV ')/ - data paramlist(441) /gribparam(133,202,0,3,207,'CNVUMF ')/ - data paramlist(442) /gribparam(133,209,0,3,208,'CNVDMF ')/ - data paramlist(443) /gribparam(133,219,0,3,209,'CNVDEMF ')/ - data paramlist(444) /gribparam(133,173,0,1,217,'LRGMR ')/ - data paramlist(445) /gribparam(133,174,0,14,195,'VDFOZ ')/ - data paramlist(446) /gribparam(133,175,0,14,196,'POZ ')/ - data paramlist(447) /gribparam(133,188,0,14,197,'TOZ ')/ - data paramlist(448) /gribparam(133,139,0,14,198,'POZT ')/ - data paramlist(449) /gribparam(133,239,0,14,199,'POZO ')/ - data paramlist(450) /gribparam(133,185,2,0,208,'AKHS ')/ - data paramlist(451) /gribparam(133,186,2,0,209,'AKMS ')/ - data paramlist(452) /gribparam(133,193,0,19,218,'EPSR ')/ - data paramlist(453) /gribparam(130,229,0,0,192,'SNOHF ')/ - data paramlist(454) /gribparam(129,194,0,0,204,'TCHP ')/ -! Added 5/29/2008 - data paramlist(455) /gribparam(2,185,0,19,219,'TPFI ')/ - data paramlist(456) /gribparam(130,182,0,7,198,'LAI ')/ - data paramlist(457) /gribparam(2,173,0,3,210,'LMH ')/ - data paramlist(458) /gribparam(2,174,0,2,218,'LMV ')/ -! Added 6/30/2008 Add GRIB1 parameters in Table version 131 - data paramlist(459) /gribparam(131,1,0,3,0,'PRES')/ - data paramlist(460) /gribparam(131,2,0,3,1,'PRMSL')/ - data paramlist(461) /gribparam(131,3,0,3,2,'PTEND')/ - data paramlist(462) /gribparam(131,4,0,2,14,'PVORT')/ - data paramlist(463) /gribparam(131,5,0,3,3,'ICAHT')/ - data paramlist(464) /gribparam(131,6,0,3,4,'GP')/ - data paramlist(465) /gribparam(131,7,0,3,5,'HGT')/ - data paramlist(466) /gribparam(131,8,0,3,6,'DIST')/ - data paramlist(467) /gribparam(131,9,0,3,7,'HSTDV')/ - data paramlist(468) /gribparam(131,10,0,14,0,'TOZNE')/ - data paramlist(469) /gribparam(131,11,0,0,0,'TMP')/ - data paramlist(470) /gribparam(131,12,0,0,1,'VTMP')/ - data paramlist(471) /gribparam(131,13,0,0,2,'POT')/ - data paramlist(472) /gribparam(131,14,0,0,3,'EPOT')/ - data paramlist(473) /gribparam(131,15,0,0,4,'TMAX')/ - data paramlist(474) /gribparam(131,16,0,0,5,'TMIN')/ - data paramlist(475) /gribparam(131,17,0,0,6,'DPT')/ - data paramlist(476) /gribparam(131,18,0,0,7,'DEPR')/ - data paramlist(477) /gribparam(131,19,0,0,8,'LAPR')/ - data paramlist(478) /gribparam(131,20,0,19,0,'VIS')/ - data paramlist(479) /gribparam(131,21,0,15,6,'RDSP1')/ - data paramlist(480) /gribparam(131,22,0,15,7,'RDSP2')/ - data paramlist(481) /gribparam(131,23,0,15,8,'RDSP3')/ - data paramlist(482) /gribparam(131,24,0,7,0,'PLI')/ - data paramlist(483) /gribparam(131,25,0,0,9,'TMPA')/ - data paramlist(484) /gribparam(131,26,0,3,8,'PRESA')/ - data paramlist(485) /gribparam(131,27,0,3,9,'GPA')/ - data paramlist(486) /gribparam(131,28,10,0,0,'WVSP1')/ - data paramlist(487) /gribparam(131,29,10,0,1,'WVSP2')/ - data paramlist(488) /gribparam(131,30,10,0,2,'WVSP3')/ - data paramlist(489) /gribparam(131,31,0,2,0,'WDIR')/ - data paramlist(490) /gribparam(131,32,0,2,1,'WIND')/ - data paramlist(491) /gribparam(131,33,0,2,2,'UGRD')/ - data paramlist(492) /gribparam(131,34,0,2,3,'VGRD')/ - data paramlist(493) /gribparam(131,35,0,2,4,'STRM')/ - data paramlist(494) /gribparam(131,36,0,2,5,'VPOT')/ - data paramlist(495) /gribparam(131,37,0,2,6,'MNTSF')/ - data paramlist(496) /gribparam(131,38,0,2,7,'SGCVV')/ - data paramlist(497) /gribparam(131,39,0,2,8,'VVEL')/ - data paramlist(498) /gribparam(131,40,0,2,9,'DZDT')/ - data paramlist(499) /gribparam(131,41,0,2,10,'ABSV')/ - data paramlist(500) /gribparam(131,42,0,2,11,'ABSD')/ - data paramlist(501) /gribparam(131,43,0,2,12,'RELV')/ - data paramlist(502) /gribparam(131,44,0,2,13,'RELD')/ - data paramlist(503) /gribparam(131,45,0,2,15,'VUCSH')/ - data paramlist(504) /gribparam(131,46,0,2,16,'VVCSH')/ - data paramlist(505) /gribparam(131,47,10,1,0,'DIRC')/ - data paramlist(506) /gribparam(131,48,10,1,1,'SPC')/ - data paramlist(507) /gribparam(131,49,10,1,2,'UOGRD')/ - data paramlist(508) /gribparam(131,50,10,1,3,'VOGRD')/ - data paramlist(509) /gribparam(131,51,0,1,0,'SPFH')/ - data paramlist(510) /gribparam(131,52,0,1,1,'RH')/ - data paramlist(511) /gribparam(131,53,0,1,2,'MIXR')/ - data paramlist(512) /gribparam(131,54,0,1,3,'PWAT')/ - data paramlist(513) /gribparam(131,55,0,1,4,'VAPP')/ - data paramlist(514) /gribparam(131,56,0,1,5,'SATD')/ - data paramlist(515) /gribparam(131,57,0,1,6,'EVP')/ - data paramlist(516) /gribparam(131,58,0,6,0,'CICE')/ - data paramlist(517) /gribparam(131,59,0,1,7,'PRATE')/ - data paramlist(518) /gribparam(131,60,0,19,2,'TSTM')/ - data paramlist(519) /gribparam(131,61,0,1,8,'APCP')/ - data paramlist(520) /gribparam(131,62,0,1,9,'NCPCP')/ - data paramlist(521) /gribparam(131,63,0,1,10,'ACPCP')/ - data paramlist(522) /gribparam(131,64,0,1,12,'SRWEQ')/ - data paramlist(523) /gribparam(131,65,0,1,13,'WEASD')/ - data paramlist(524) /gribparam(131,66,0,1,11,'SNOD')/ - data paramlist(525) /gribparam(131,67,0,19,3,'MIXHT')/ - data paramlist(526) /gribparam(131,68,10,4,2,'TTHDP')/ - data paramlist(527) /gribparam(131,69,10,4,0,'MTHD')/ - data paramlist(528) /gribparam(131,70,10,4,1,'MTHA')/ - data paramlist(529) /gribparam(131,71,0,6,1,'TCDC')/ - data paramlist(530) /gribparam(131,72,0,6,2,'CDCON')/ - data paramlist(531) /gribparam(131,73,0,6,3,'LCDC')/ - data paramlist(532) /gribparam(131,74,0,6,4,'MCDC')/ - data paramlist(533) /gribparam(131,75,0,6,5,'HCDC')/ - data paramlist(534) /gribparam(131,76,0,6,6,'CWAT')/ - data paramlist(535) /gribparam(131,77,0,7,1,'BLI')/ - data paramlist(536) /gribparam(131,78,0,1,14,'SNOC')/ - data paramlist(537) /gribparam(131,79,0,1,15,'SNOL')/ - data paramlist(538) /gribparam(131,80,10,3,0,'WTMP')/ - data paramlist(539) /gribparam(131,81,2,0,0,'LAND')/ - data paramlist(540) /gribparam(131,82,10,3,1,'DSLM')/ - data paramlist(541) /gribparam(131,83,2,0,1,'SFCR')/ - data paramlist(542) /gribparam(131,84,0,19,1,'ALBDO')/ - data paramlist(543) /gribparam(131,85,2,0,2,'TSOIL')/ - data paramlist(544) /gribparam(131,86,2,0,3,'SOILM')/ - data paramlist(545) /gribparam(131,87,2,0,4,'VEG')/ - data paramlist(546) /gribparam(131,88,10,4,3,'SALTY')/ - data paramlist(547) /gribparam(131,89,0,3,10,'DEN')/ - data paramlist(548) /gribparam(131,90,2,0,5,'WATR')/ - data paramlist(549) /gribparam(131,91,10,2,0,'ICEC')/ - data paramlist(550) /gribparam(131,92,10,2,1,'ICETK')/ - data paramlist(551) /gribparam(131,93,10,2,2,'DICED')/ - data paramlist(552) /gribparam(131,94,10,2,3,'SICED')/ - data paramlist(553) /gribparam(131,95,10,2,4,'UICE')/ - data paramlist(554) /gribparam(131,96,10,2,5,'VICE')/ - data paramlist(555) /gribparam(131,97,10,2,6,'ICEG')/ - data paramlist(556) /gribparam(131,98,10,2,7,'ICED')/ - data paramlist(557) /gribparam(131,99,0,1,16,'SNOM')/ - data paramlist(558) /gribparam(131,100,10,0,3,'HTSGW')/ - data paramlist(559) /gribparam(131,101,10,0,4,'WVDIR')/ - data paramlist(560) /gribparam(131,102,10,0,5,'WVHGT')/ - data paramlist(561) /gribparam(131,103,10,0,6,'WVPER')/ - data paramlist(562) /gribparam(131,104,10,0,7,'SWDIR')/ - data paramlist(563) /gribparam(131,105,10,0,8,'SWELL')/ - data paramlist(564) /gribparam(131,106,10,0,9,'SWPER')/ - data paramlist(565) /gribparam(131,107,10,0,10,'DIRPW')/ - data paramlist(566) /gribparam(131,108,10,0,11,'PERPW')/ - data paramlist(567) /gribparam(131,109,10,0,12,'DIRSW')/ - data paramlist(568) /gribparam(131,110,10,0,13,'PERSW')/ - data paramlist(569) /gribparam(131,111,0,4,0,'NSWRS')/ - data paramlist(570) /gribparam(131,112,0,5,0,'NLWRS')/ - data paramlist(571) /gribparam(131,113,0,4,1,'NSWRT')/ - data paramlist(572) /gribparam(131,114,0,5,1,'NLWRT')/ - data paramlist(573) /gribparam(131,115,0,5,2,'LWAVR')/ - data paramlist(574) /gribparam(131,116,0,4,2,'SWAVR')/ - data paramlist(575) /gribparam(131,117,0,4,3,'GRAD')/ - data paramlist(576) /gribparam(131,118,0,4,4,'BRTMP')/ - data paramlist(577) /gribparam(131,119,0,4,5,'LWRAD')/ - data paramlist(578) /gribparam(131,120,0,4,6,'SWRAD')/ - data paramlist(579) /gribparam(131,121,0,0,10,'LHTFL')/ - data paramlist(580) /gribparam(131,122,0,0,11,'SHTFL')/ - data paramlist(581) /gribparam(131,123,0,2,20,'BLYDP')/ - data paramlist(582) /gribparam(131,124,0,2,17,'UFLX')/ - data paramlist(583) /gribparam(131,125,0,2,18,'VFLX')/ - data paramlist(584) /gribparam(131,126,0,2,19,'WMIXE')/ - data paramlist(585) /gribparam(131,127,255,255,255,'IMGD')/ - data paramlist(586) /gribparam(131,128,0,3,1,'MSLSA')/ - data paramlist(587) /gribparam(131,130,0,3,192,'MSLET')/ - data paramlist(588) /gribparam(131,131,0,7,192,'LFTX')/ - data paramlist(589) /gribparam(131,132,0,7,193,'4LFTX')/ - data paramlist(590) /gribparam(131,134,0,3,212,'PRESN')/ - data paramlist(591) /gribparam(131,135,0,1,197,'MCONV')/ - data paramlist(592) /gribparam(131,136,0,2,192,'VWSH')/ - data paramlist(593) /gribparam(131,137,0,2,219,'PVMWW')/ - data paramlist(594) /gribparam(131,140,0,1,192,'CRAIN')/ - data paramlist(595) /gribparam(131,141,0,1,193,'CFRZR')/ - data paramlist(596) /gribparam(131,142,0,1,194,'CICEP')/ - data paramlist(597) /gribparam(131,143,0,1,195,'CSNOW')/ - data paramlist(598) /gribparam(131,144,2,0,192,'SOILW')/ - data paramlist(599) /gribparam(131,145,0,1,200,'PEVPR')/ - data paramlist(600) /gribparam(131,146,2,2,210,'VEGT')/ - data paramlist(601) /gribparam(131,147,2,3,200,'BARET')/ - data paramlist(602) /gribparam(131,148,2,3,201,'AVSFT')/ - data paramlist(603) /gribparam(131,149,2,3,202,'RADT')/ - data paramlist(604) /gribparam(131,150,2,2,211,'SSTOR')/ - data paramlist(605) /gribparam(131,151,2,2,212,'LSOIL')/ - data paramlist(606) /gribparam(131,152,2,2,213,'EWATR')/ - data paramlist(607) /gribparam(131,153,0,1,22,'CLWMR')/ - data paramlist(608) /gribparam(131,155,2,0,193,'GFLUX')/ - data paramlist(609) /gribparam(131,156,0,7,7,'CIN')/ - data paramlist(610) /gribparam(131,157,0,7,6,'CAPE')/ - data paramlist(611) /gribparam(131,158,0,19,11,'TKE')/ - data paramlist(612) /gribparam(131,159,0,19,192,'MXSALB')/ - data paramlist(613) /gribparam(131,160,2,3,192,'SOILL')/ - data paramlist(614) /gribparam(131,161,0,1,29,'ASNOW')/ - data paramlist(615) /gribparam(131,162,0,1,221,'ARAIN')/ - data paramlist(616) /gribparam(131,163,2,0,214,'GWREC')/ - data paramlist(617) /gribparam(131,164,2,0,215,'QREC')/ - data paramlist(618) /gribparam(131,165,0,1,222,'SNOWT')/ - data paramlist(619) /gribparam(131,166,0,4,200,'VBDSF')/ - data paramlist(620) /gribparam(131,167,0,4,201,'VDDSF')/ - data paramlist(621) /gribparam(131,168,0,4,202,'NBDSF')/ - data paramlist(622) /gribparam(131,169,0,4,203,'NDDSF')/ - data paramlist(623) /gribparam(131,170,0,19,193,'SNFALB')/ - data paramlist(624) /gribparam(131,171,2,3,193,'RLYRS')/ - data paramlist(625) /gribparam(131,172,0,2,193,'MFLX')/ - data paramlist(626) /gribparam(131,173,0,3,210,'LMH')/ - data paramlist(627) /gribparam(131,174,0,2,218,'LMV')/ - data paramlist(628) /gribparam(131,175,0,191,195,'MLYNO')/ - data paramlist(629) /gribparam(131,176,0,191,192,'NLAT')/ - data paramlist(630) /gribparam(131,177,0,191,193,'ELON')/ - data paramlist(631) /gribparam(131,178,0,1,23,'ICMR')/ - data paramlist(632) /gribparam(131,179,2,0,210,'ACOND')/ - data paramlist(633) /gribparam(131,180,0,1,17,'SNOAG')/ - data paramlist(634) /gribparam(131,181,2,0,199,'CCOND')/ - data paramlist(635) /gribparam(131,182,0,7,198,'LAI')/ - data paramlist(636) /gribparam(131,183,2,0,216,'SFCRH')/ - data paramlist(637) /gribparam(131,184,0,19,19,'SALBD')/ - data paramlist(638) /gribparam(131,187,2,0,217,'NDVI')/ - data paramlist(639) /gribparam(131,188,2,0,206,'RDRIP')/ - data paramlist(640) /gribparam(131,189,2,0,218,'LANDN')/ - data paramlist(641) /gribparam(131,190,0,7,8,'HLCY')/ - data paramlist(642) /gribparam(131,191,0,191,196,'NLATN')/ - data paramlist(643) /gribparam(131,192,0,191,197,'ELONN')/ - data paramlist(644) /gribparam(131,194,1,1,193,'CPOFP')/ - data paramlist(645) /gribparam(131,196,0,2,194,'USTM')/ - data paramlist(646) /gribparam(131,197,0,2,195,'VSTM')/ - data paramlist(647) /gribparam(131,198,0,1,212,'SBSNO')/ - data paramlist(648) /gribparam(131,199,2,3,198,'EVBS')/ - data paramlist(649) /gribparam(131,200,2,0,208,'EVCW')/ - data paramlist(650) /gribparam(131,202,0,1,223,'APCPN')/ - data paramlist(651) /gribparam(131,203,2,0,200,'RSMIN')/ - data paramlist(652) /gribparam(131,204,0,4,192,'DSWRF')/ - data paramlist(653) /gribparam(131,205,0,5,192,'DLWRF')/ - data paramlist(654) /gribparam(131,206,0,1,224,'ACPCPN')/ - data paramlist(655) /gribparam(131,207,2,0,194,'MSTAV')/ - data paramlist(656) /gribparam(131,208,2,0,195,'SFEXC')/ - data paramlist(657) /gribparam(131,210,2,0,209,'TRANS')/ - data paramlist(658) /gribparam(131,211,0,4,193,'USWRF')/ - data paramlist(659) /gribparam(131,212,0,5,193,'ULWRF')/ - data paramlist(660) /gribparam(131,213,0,6,192,'CDLYR')/ - data paramlist(661) /gribparam(131,214,0,1,196,'CPRAT')/ - data paramlist(662) /gribparam(131,216,0,0,193,'TTRAD')/ - data paramlist(663) /gribparam(131,218,0,3,211,'HGTN')/ - data paramlist(664) /gribparam(131,219,2,0,201,'WILT')/ - data paramlist(665) /gribparam(130,220,2,3,203,'FLDCP')/ - data paramlist(666) /gribparam(131,221,0,3,196,'HPBL')/ - data paramlist(667) /gribparam(131,222,2,3,194,'SLTYP')/ - data paramlist(668) /gribparam(131,223,2,0,196,'CNWAT')/ - data paramlist(669) /gribparam(131,224,2,3,0,'SOTYP')/ - data paramlist(670) /gribparam(131,225,2,0,198,'VGTYP')/ - data paramlist(671) /gribparam(131,226,2,0,197,'BMIXL')/ - data paramlist(672) /gribparam(131,227,2,0,219,'AMIXL')/ - data paramlist(673) /gribparam(131,228,0,1,199,'PEVAP')/ - data paramlist(674) /gribparam(131,229,0,0,192,'SNOHF')/ - data paramlist(675) /gribparam(131,230,2,3,195,'SMREF')/ - data paramlist(676) /gribparam(131,231,2,3,196,'SMDRY')/ - data paramlist(677) /gribparam(131,232,2,0,220,'WVINC')/ - data paramlist(678) /gribparam(131,233,2,0,221,'WCINC')/ - data paramlist(679) /gribparam(131,234,1,0,192,'BGRUN')/ - data paramlist(680) /gribparam(131,235,1,0,193,'SSRUN')/ - data paramlist(681) /gribparam(131,237,2,0,222,'WVCONV')/ - data paramlist(682) /gribparam(131,238,0,1,201,'SNOWC')/ - data paramlist(683) /gribparam(131,239,0,1,208,'SNOT')/ - data paramlist(684) /gribparam(131,240,2,3,197,'POROS')/ - data paramlist(685) /gribparam(131,241,2,0,223,'WCCONV')/ - data paramlist(686) /gribparam(131,242,2,0,224,'WVUFLX')/ - data paramlist(687) /gribparam(131,243,2,0,225,'WVVFLX')/ - data paramlist(688) /gribparam(131,244,2,0,226,'WCUFLX')/ - data paramlist(689) /gribparam(131,245,2,0,227,'WCVFLX')/ - data paramlist(690) /gribparam(131,246,2,0,202,'RCS')/ - data paramlist(691) /gribparam(131,247,2,0,203,'RCT')/ - data paramlist(692) /gribparam(131,248,2,0,204,'RCQ')/ - data paramlist(693) /gribparam(131,249,2,0,205,'RCSOL')/ - data paramlist(694) /gribparam(131,250,0,4,197,'SWHR')/ - data paramlist(695) /gribparam(131,251,0,5,194,'LWHR')/ - data paramlist(696) /gribparam(131,252,0,2,196,'CD')/ - data paramlist(697) /gribparam(131,253,0,2,197,'FRICV')/ - data paramlist(698) /gribparam(131,254,0,7,194,'RI')/ - data paramlist(699) /gribparam(129,62,0,1,9,'NCPCP')/ - data paramlist(700) /gribparam(129,63,0,1,10,'ACPCP')/ - data paramlist(701) /gribparam(131,220,2,3,203,'FLDCP')/ - - - data paramlist(702) /gribparam(128,221,1,0,221,'FFLDG')/ - data paramlist(703) /gribparam(128,222,1,0,222,'FFLDG')/ - data paramlist(704) /gribparam(128,223,1,0,223,'FFLDG')/ - - data paramlist(705) /gribparam(128,224,1,0,224,'FFLDG')/ - data paramlist(706) /gribparam(128,225,1,0,225,'FFLDG')/ - data paramlist(707) /gribparam(128,226,1,0,226,'FFLDG')/ - data paramlist(708) /gribparam(128,227,1,0,227,'FFLDG')/ - data paramlist(709) /gribparam(128,228,1,0,228,'FFLDG')/ - data paramlist(710) /gribparam(128,229,1,0,229,'FFLDG')/ - data paramlist(711) /gribparam(128,230,1,0,230,'FFLDG')/ - data paramlist(712) /gribparam(128,237,1,0,237,'FFLDG')/ - data paramlist(713) /gribparam(128,239,1,0,239,'FFLDG')/ - data paramlist(714) /gribparam(128,242,1,0,242,'FFLDG')/ - data paramlist(715) /gribparam(128,247,1,0,247,'FFLDG')/ - data paramlist(716) /gribparam(128,250,1,0,250,'FFLDG')/ - -! Aviation parameters - data paramlist(717) /gribparam(129,175,0,19,20,'ICIP')/ - data paramlist(718) /gribparam(129,176,0,19,7,'ICI')/ - data paramlist(719) /gribparam(2,236,0,19,23,'SLDP')/ - - contains - - - subroutine param_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: param_g1_to_g2 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-05 -! -! ABSTRACT: This subroutine returns the corresponding GRIB2 Discipline -! Category and Number for a given GRIB1 parameter value and table version. -! -! PROGRAM HISTORY LOG: -! 2000-05-11 Gilbert -! -! USAGE: CALL param_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num) -! INPUT ARGUMENT LIST: -! g1val - GRIB1 parameter number for which discipline is requested -! g1ver - GRIB1 parameter table version number -! -! OUTPUT ARGUMENT LIST: -! g2disc - corresponding GRIB2 Discipline number -! g2cat - corresponding GRIB2 Category number -! g2num - corresponding GRIB2 Parameter number within Category g2cat -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: g1val,g1ver - integer,intent(out) :: g2disc,g2cat,g2num - - g2disc=255 - g2cat=255 - g2num=255 -! for testing -! g2num=g1val -! for testing - - do n=1,MAXPARAM - if (paramlist(n)%grib1val.eq.g1val .AND. - & paramlist(n)%g1tblver.eq.g1ver ) then - g2disc=paramlist(n)%grib2dsc - g2cat=paramlist(n)%grib2cat - g2num=paramlist(n)%grib2num - return - endif - enddo - - print *,'param_g1_to_g2:GRIB1 param ',g1val,' not found.', - & ' for table version ',g1ver - return - end subroutine - - character(len=8) function param_get_abbrev(g2disc,g2cat,g2num) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: param_get_abbrev -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-04 -! -! ABSTRACT: This function returns the parameter abbreviation for -! a given GRIB2 Discipline, Category and Parameter number. -! -! PROGRAM HISTORY LOG: -! 2001-06-05 Gilbert -! -! USAGE: abrev=param_get_abbrev(g2disc,g2cat,g2num) -! INPUT ARGUMENT LIST: -! g2disc - GRIB2 discipline number (See Code Table 0.0) -! g2cat - corresponding GRIB2 Category number -! g2num - corresponding GRIB2 Parameter number within Category g2cat -! -! RETURNS: ASCII Paramter Abbreviation -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: g2disc,g2cat,g2num - - param_get_abbrev='UNKNOWN ' - - do n=1,MAXPARAM - if (paramlist(n)%grib2dsc.eq.g2disc.AND. - & paramlist(n)%grib2cat.eq.g2cat.AND. - & paramlist(n)%grib2num.eq.g2num) then - param_get_abbrev=paramlist(n)%abbrev - return - endif - enddo - -! print *,'param_get_abbrev:GRIB2 param ',g2disc,g2cat, -! & g2num,' not found.' - return - end function - - - subroutine param_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: param_g2_to_g1 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-04 -! -! ABSTRACT: This function returns the GRIB 1 parameter number for -! a given GRIB2 Discipline, Category and Parameter number. -! -! PROGRAM HISTORY LOG: -! 2001-06-05 Gilbert -! -! USAGE: call param_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver) -! INPUT ARGUMENT LIST: -! g2disc - GRIB2 discipline number (See Code Table 0.0) -! g2cat - corresponding GRIB2 Category number -! g2num - corresponding GRIB2 Parameter number within Category g2cat -! -! OUTPUT ARGUMENT LIST: -! g1val - GRIB1 parameter number for which discipline is requested -! g1ver - GRIB1 parameter table version number -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: g2disc,g2cat,g2num - integer,intent(out) :: g1val,g1ver - - g1val=255 - g1ver=255 - -! for testing -! if ( g2disc.eq.255.and.g2cat.eq.255 ) then -! g1val=g2num -! g1ver=2 -! return -! endif -! for testing - - do n=1,MAXPARAM - if (paramlist(n)%grib2dsc.eq.g2disc.AND. - & paramlist(n)%grib2cat.eq.g2cat.AND. - & paramlist(n)%grib2num.eq.g2num) then - g1val=paramlist(n)%grib1val - g1ver=paramlist(n)%g1tblver - return - endif - enddo - - print *,'param_g2_to_g1:GRIB2 param ',g2disc,g2cat, - & g2num,' not found.' - return - end subroutine - - end module diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params.mod deleted file mode 100644 index 3fbf00d187..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params.mod +++ /dev/null @@ -1,63 +0,0 @@ -GFORTRAN module created from params.f on Mon Nov 16 16:43:03 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'gribparam' 'params' 1 ((DERIVED UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(UNKNOWN 0 ()) 0 0 () () 0 ((3 'g1tblver' (INTEGER 4 ()) () 0 0 ()) (4 -'grib1val' (INTEGER 4 ()) () 0 0 ()) (5 'grib2dsc' (INTEGER 4 ()) () 0 0 -()) (6 'grib2cat' (INTEGER 4 ()) () 0 0 ()) (7 'grib2num' (INTEGER 4 ()) -() 0 0 ()) (8 'abbrev' (CHARACTER 1 ((CONSTANT (INTEGER 4 ()) 0 '8'))) () -0 0 ())) PUBLIC ()) -9 'param_g1_to_g2' 'params' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL SUBROUTINE) (UNKNOWN 0 ()) 10 0 (11 12 13 14 15) () 0 () ()) -16 'param_g2_to_g1' 'params' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL SUBROUTINE) (UNKNOWN 0 ()) 17 0 (18 19 20 21 22) () 0 () ()) -23 'maxparam' 'params' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '716') () 0 () ()) -24 'param_get_abbrev' 'params' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL FUNCTION) (CHARACTER 1 ((CONSTANT (INTEGER 4 ()) 0 '8'))) 25 0 (26 -27 28) () 24 () ()) -29 'params' 'params' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) ( -UNKNOWN 0 ()) 0 0 () () 0 () ()) -30 'paramlist' 'params' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN -DIMENSION DATA) (DERIVED 2 ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 ()) -0 '1') (CONSTANT (INTEGER 4 ()) 0 '716')) 0 () ()) -15 'g2num' '' 10 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -13 'g2disc' '' 10 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 -()) 0 0 () () 0 () ()) -11 'g1val' '' 10 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -12 'g1ver' '' 10 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -27 'g2cat' '' 25 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -26 'g2disc' '' 25 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -20 'g2num' '' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -21 'g1val' '' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -28 'g2num' '' 25 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -19 'g2cat' '' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -14 'g2cat' '' 10 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -22 'g1ver' '' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -18 'g2disc' '' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -) - -('paramlist' 0 30 'param_get_abbrev' 0 24 'maxparam' 0 23 'gribparam' 0 -2 'param_g2_to_g1' 0 16 'param_g1_to_g2' 0 9 'params' 0 29) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params_ecmwf.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params_ecmwf.f deleted file mode 100755 index 3b6a63c100..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params_ecmwf.f +++ /dev/null @@ -1,336 +0,0 @@ - module params_ecmwf -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! MODULE: params_ecmwf -! PRGMMR: Gordon ORG: W/NP11 DATE: 2006-09-07 -! -! ABSTRACT: This Fortran Module contains info on all the available -! ECMWF GRIB Parameters. -! -! PROGRAM HISTORY LOG: -! 2006-09-07 Gordon - Modified from Steve Gilbert's params.f for NCEP GRIB data -! 2007-04-20 Vuong - Add more parameters -! 2007-10-11 Vuong - Add more parameters -! -! USAGE: use params -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,parameter :: MAXPARAM=177 - - type gribparam - integer :: g1tblver - integer :: grib1val - integer :: grib2dsc - integer :: grib2cat - integer :: grib2num - character(len=8) :: abbrev - end type gribparam - - type(gribparam),dimension(MAXPARAM) :: paramlist - - data paramlist(1) /gribparam(128,1,255,255,255,'STRF ')/ - data paramlist(2) /gribparam(128,002,255,255,255,'VPOT ')/ - data paramlist(3) /gribparam(128,003,255,255,255,'THTA ')/ - data paramlist(4) /gribparam(128,004,255,255,255,'THTE ')/ - data paramlist(5) /gribparam(128,005,255,255,255,'THTS ')/ - data paramlist(6) /gribparam(128,011,255,255,255,'UDVW ')/ - data paramlist(7) /gribparam(128,012,255,255,255,'VDVW ')/ - data paramlist(8) /gribparam(128,013,255,255,255,'URTW ')/ - data paramlist(9) /gribparam(128,014,255,255,255,'VRTW ')/ - data paramlist(10) /gribparam(128,021,255,255,255,'UCTP ')/ - data paramlist(11) /gribparam(128,022,255,255,255,'UCLN ')/ - data paramlist(12) /gribparam(128,023,255,255,255,'UCDV ')/ - data paramlist(13) /gribparam(128,026,255,255,255,'CLAK ')/ - data paramlist(14) /gribparam(128,027,255,255,255,'CVEGL ')/ - data paramlist(15) /gribparam(128,028,255,255,255,'CVEGH ')/ - data paramlist(16) /gribparam(128,029,255,255,255,'TVEGL ')/ - data paramlist(17) /gribparam(128,030,255,255,255,'TVEGH ')/ - data paramlist(18) /gribparam(128,031,255,255,255,'CSICE ')/ - data paramlist(19) /gribparam(128,032,255,255,255,'ASNOW ')/ - data paramlist(20) /gribparam(128,033,255,255,255,'RSNOW ')/ - data paramlist(21) /gribparam(128,034,255,255,255,'SSTK ')/ - data paramlist(22) /gribparam(128,035,255,255,255,'ISTL1 ')/ - data paramlist(23) /gribparam(128,036,255,255,255,'ISTL2 ')/ - data paramlist(24) /gribparam(128,037,255,255,255,'ISTL3 ')/ - data paramlist(25) /gribparam(128,038,255,255,255,'ISTL4 ')/ - data paramlist(26) /gribparam(128,039,255,255,255,'SWVL1 ')/ - data paramlist(27) /gribparam(128,040,255,255,255,'SWVL2 ')/ - data paramlist(28) /gribparam(128,041,255,255,255,'SWVL3 ')/ - data paramlist(29) /gribparam(128,042,255,255,255,'SWVL4 ')/ - data paramlist(30) /gribparam(128,043,255,255,255,'SOILT ')/ - data paramlist(31) /gribparam(128,044,255,255,255,'ESNOW ')/ - data paramlist(32) /gribparam(128,045,255,255,255,'SMLT ')/ - data paramlist(33) /gribparam(128,046,255,255,255,'SDUR ')/ - data paramlist(34) /gribparam(128,047,255,255,255,'DSRP ')/ - data paramlist(35) /gribparam(128,048,255,255,255,'MAGSS ')/ - data paramlist(36) /gribparam(128,049,255,255,255,'GUST ')/ - data paramlist(37) /gribparam(128,050,255,255,255,'LSPF ')/ - data paramlist(38) /gribparam(128,051,255,255,255,'TMXK24 ')/ - data paramlist(39) /gribparam(128,052,255,255,255,'TMNK24 ')/ - data paramlist(40) /gribparam(128,053,255,255,255,'MONT ')/ - data paramlist(41) /gribparam(128,054,255,255,255,'PRES ')/ - data paramlist(42) /gribparam(128,060,255,255,255,'PVOR ')/ - data paramlist(43) /gribparam(128,127,255,255,255,'ATIDE ')/ - data paramlist(44) /gribparam(128,128,255,255,255,'BVAL ')/ - data paramlist(45) /gribparam(128,129,255,255,255,'HGHT ')/ - data paramlist(46) /gribparam(128,130,0,0,0,'TMPK ')/ - data paramlist(47) /gribparam(128,131,0,2,2,'UWND ')/ - data paramlist(48) /gribparam(128,132,0,2,3,'VWND ')/ - data paramlist(49) /gribparam(128,133,255,255,255,'SPCH ')/ - data paramlist(50) /gribparam(128,134,255,255,255,'PRES ')/ - data paramlist(51) /gribparam(128,135,255,255,255,'OMEG ')/ - data paramlist(52) /gribparam(128,136,255,255,255,'TCWTR ')/ - data paramlist(53) /gribparam(128,137,255,255,255,'TCWV ')/ - data paramlist(54) /gribparam(128,138,255,255,255,'VORT ')/ - data paramlist(55) /gribparam(128,139,255,255,255,'STL1 ')/ - data paramlist(56) /gribparam(128,140,255,255,255,'SWL1 ')/ - data paramlist(57) /gribparam(128,141,255,255,255,'SNOWD ')/ - data paramlist(58) /gribparam(128,142,255,255,255,'S--M ')/ - data paramlist(59) /gribparam(128,143,255,255,255,'C--M ')/ - data paramlist(60) /gribparam(128,144,255,255,255,'SNOW ')/ - data paramlist(61) /gribparam(128,145,255,255,255,'BLDS ')/ - data paramlist(62) /gribparam(128,146,255,255,255,'SSHF ')/ - data paramlist(63) /gribparam(128,147,255,255,255,'SLHF ')/ - data paramlist(64) /gribparam(128,148,255,255,255,'CHNK ')/ - data paramlist(65) /gribparam(128,149,255,255,255,'SNRAD ')/ - data paramlist(66) /gribparam(128,150,255,255,255,'TNRAD ')/ - data paramlist(67) /gribparam(128,151,0,3,1,'PMSL ')/ - data paramlist(68) /gribparam(128,152,255,255,255,'LNSP ')/ - data paramlist(69) /gribparam(128,153,255,255,255,'SWHR ')/ - data paramlist(70) /gribparam(128,154,255,255,255,'LWHR ')/ - data paramlist(71) /gribparam(128,155,255,255,255,'DIVG ')/ - data paramlist(72) /gribparam(128,156,0,3,5,'HGHT ')/ - data paramlist(73) /gribparam(128,157,0,1,1,'RELH ')/ - data paramlist(74) /gribparam(128,158,255,255,255,'TSPRES ')/ - data paramlist(75) /gribparam(128,159,255,255,255,'BLHGHT ')/ - data paramlist(76) /gribparam(128,160,255,255,255,'SDOR ')/ - data paramlist(77) /gribparam(128,161,255,255,255,'ISOR ')/ - data paramlist(78) /gribparam(128,162,255,255,255,'ANOR ')/ - data paramlist(79) /gribparam(128,163,255,255,255,'SLOR ')/ - data paramlist(80) /gribparam(128,164,0,6,1,'TCLD ')/ - data paramlist(81) /gribparam(128,165,0,2,2,'UWND ')/ - data paramlist(82) /gribparam(128,166,0,2,3,'VWND ')/ - data paramlist(83) /gribparam(128,167,0,0,0,'TMPK ')/ - data paramlist(84) /gribparam(128,168,0,0,6,'DWPK ')/ - data paramlist(85) /gribparam(128,169,255,255,255,'SSRD ')/ - data paramlist(86) /gribparam(128,170,255,255,255,'STL2 ')/ - data paramlist(87) /gribparam(128,171,255,255,255,'SWL2 ')/ - data paramlist(88) /gribparam(128,172,255,255,255,'LAND ')/ - data paramlist(89) /gribparam(128,173,255,255,255,'SROUGH ')/ - data paramlist(90) /gribparam(128,174,255,255,255,'ALBD ')/ - data paramlist(91) /gribparam(128,175,255,255,255,'STRD ')/ - data paramlist(92) /gribparam(128,176,255,255,255,'SSRAD ')/ - data paramlist(93) /gribparam(128,177,255,255,255,'STRAD ')/ - data paramlist(94) /gribparam(128,178,255,255,255,'TSRAD ')/ - data paramlist(95) /gribparam(128,179,255,255,255,'TTRAD ')/ - data paramlist(96) /gribparam(128,180,255,255,255,'EWSS ')/ - data paramlist(97) /gribparam(128,181,255,255,255,'NSSS ')/ - data paramlist(98) /gribparam(128,182,255,255,255,'EVAP ')/ - data paramlist(99) /gribparam(128,183,255,255,255,'STL3 ')/ - data paramlist(100) /gribparam(128,184,255,255,255,'SWL3 ')/ - data paramlist(101) /gribparam(128,185,255,255,255,'CCLD ')/ - data paramlist(102) /gribparam(128,186,255,255,255,'LCLD ')/ - data paramlist(103) /gribparam(128,187,255,255,255,'MCLD ')/ - data paramlist(104) /gribparam(128,188,255,255,255,'HCLD ')/ - data paramlist(105) /gribparam(128,189,255,255,255,'SUND ')/ - data paramlist(106) /gribparam(128,190,255,255,255,'EWOV ')/ - data paramlist(107) /gribparam(128,191,255,255,255,'NSOV ')/ - data paramlist(108) /gribparam(128,192,255,255,255,'NWOV ')/ - data paramlist(109) /gribparam(128,193,255,255,255,'NEOV ')/ - data paramlist(110) /gribparam(128,194,255,255,255,'BTMP ')/ - data paramlist(111) /gribparam(128,195,255,255,255,'LGWS ')/ - data paramlist(112) /gribparam(128,196,255,255,255,'MGWS ')/ - data paramlist(113) /gribparam(128,197,255,255,255,'GWDS ')/ - data paramlist(114) /gribparam(128,198,255,255,255,'SKRC ')/ - data paramlist(115) /gribparam(128,199,255,255,255,'VEGE ')/ - data paramlist(116) /gribparam(128,200,255,255,255,'VSGO ')/ - data paramlist(117) /gribparam(128,201,0,0,4,'TMXK ')/ - data paramlist(118) /gribparam(128,202,0,0,5,'TMNK ')/ - data paramlist(119) /gribparam(128,203,255,255,255,'OZMR ')/ - data paramlist(120) /gribparam(128,204,255,255,255,'PRAW ')/ - data paramlist(121) /gribparam(128,205,255,255,255,'RUNOFF ')/ - data paramlist(122) /gribparam(128,206,255,255,255,'TCOZ ')/ - data paramlist(123) /gribparam(128,207,255,255,255,'SPED ')/ - data paramlist(124) /gribparam(128,208,255,255,255,'TSRC ')/ - data paramlist(125) /gribparam(128,209,255,255,255,'TTRC ')/ - data paramlist(126) /gribparam(128,210,255,255,255,'SSRC ')/ - data paramlist(127) /gribparam(128,211,255,255,255,'STRC ')/ - data paramlist(128) /gribparam(128,212,255,255,255,'SINSOL ')/ - data paramlist(129) /gribparam(128,214,255,255,255,'DHRAD ')/ - data paramlist(130) /gribparam(128,215,255,255,255,'DHVD ')/ - data paramlist(131) /gribparam(128,216,255,255,255,'DHCC ')/ - data paramlist(132) /gribparam(128,217,255,255,255,'DHLC ')/ - data paramlist(133) /gribparam(128,218,255,255,255,'VDZW ')/ - data paramlist(134) /gribparam(128,219,255,255,255,'VDMW ')/ - data paramlist(135) /gribparam(128,220,255,255,255,'EWGD ')/ - data paramlist(136) /gribparam(128,221,255,255,255,'NSGD ')/ - data paramlist(137) /gribparam(128,222,255,255,255,'CTZW ')/ - data paramlist(138) /gribparam(128,223,255,255,255,'CTMW ')/ - data paramlist(139) /gribparam(128,224,255,255,255,'VDHUM ')/ - data paramlist(140) /gribparam(128,225,255,255,255,'HTCC ')/ - data paramlist(141) /gribparam(128,226,255,255,255,'HTLC ')/ - data paramlist(142) /gribparam(128,227,255,255,255,'CRNH ')/ - data paramlist(143) /gribparam(128,228,0,1,8,'A PCP ')/ - data paramlist(144) /gribparam(128,229,255,255,255,'IEWS ')/ - data paramlist(145) /gribparam(128,230,255,255,255,'INSS ')/ - data paramlist(146) /gribparam(128,231,255,255,255,'ISHF ')/ - data paramlist(147) /gribparam(128,232,255,255,255,'MFLUX ')/ - data paramlist(148) /gribparam(128,233,255,255,255,'ASHUM ')/ - data paramlist(149) /gribparam(128,234,255,255,255,'LSRH ')/ - data paramlist(150) /gribparam(128,235,255,255,255,'SKTMP ')/ - data paramlist(151) /gribparam(128,236,255,255,255,'STL4 ')/ - data paramlist(152) /gribparam(128,237,255,255,255,'SWL4 ')/ - data paramlist(153) /gribparam(128,238,255,255,255,'TSNOW ')/ - data paramlist(154) /gribparam(128,239,255,255,255,'CSNOWF ')/ - data paramlist(155) /gribparam(128,240,255,255,255,'LSNOWF ')/ - data paramlist(156) /gribparam(128,241,255,255,255,'ACLD ')/ - data paramlist(157) /gribparam(128,242,255,255,255,'ALWTND ')/ - data paramlist(158) /gribparam(128,243,255,255,255,'FALBD ')/ - data paramlist(159) /gribparam(128,244,255,255,255,'FSROUGH ')/ - data paramlist(160) /gribparam(128,245,255,255,255,'FLSR ')/ - data paramlist(161) /gribparam(128,246,255,255,255,'CLWC ')/ - data paramlist(162) /gribparam(128,247,255,255,255,'CIWC ')/ - data paramlist(163) /gribparam(128,248,255,255,255,'CLOUD ')/ - data paramlist(164) /gribparam(128,249,255,255,255,'AIWTND ')/ - data paramlist(165) /gribparam(128,250,255,255,255,'ICEAGE ')/ - data paramlist(166) /gribparam(128,251,255,255,255,'ATTE ')/ - data paramlist(167) /gribparam(128,252,255,255,255,'ATHE ')/ - data paramlist(168) /gribparam(128,253,255,255,255,'ATZE ')/ - data paramlist(169) /gribparam(128,254,255,255,255,'ATMW ')/ - data paramlist(170) /gribparam(128,255,255,255,255,'MISS ')/ -! Added 4/20/2007 - For missing GRIB1 to GRIB2 conversions - data paramlist(171) /gribparam(1,33,0,2,2,'U GRD ')/ - data paramlist(172) /gribparam(1,34,0,2,3,'V GRD ')/ - data paramlist(173) /gribparam(1,2,0,3,1,'PRMSL ')/ - data paramlist(174) /gribparam(1,7,0,3,5,'HGT ')/ -! Added 10/11/2007- Add more parameters - data paramlist(175) /gribparam(1,11,0,0,0,'TMP ')/ - data paramlist(176) /gribparam(1,52,0,1,1,'R H ')/ - data paramlist(177) /gribparam(1,41,0,2,10,'ABS V ')/ - - contains - - - subroutine param_ecmwf_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: param_ecmwf_g1_to_g2 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-05 -! -! ABSTRACT: This subroutine returns the corresponding GRIB2 Discipline -! Category and Number for a given GRIB1 parameter value and table version. -! -! PROGRAM HISTORY LOG: -! 2000-05-11 Gilbert -! -! USAGE: CALL param_ecmwf_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num) -! INPUT ARGUMENT LIST: -! g1val - GRIB1 parameter number for which discipline is requested -! g1ver - GRIB1 parameter table version number -! -! OUTPUT ARGUMENT LIST: -! g2disc - corresponding GRIB2 Discipline number -! g2cat - corresponding GRIB2 Category number -! g2num - corresponding GRIB2 Parameter number within Category g2cat -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: g1val,g1ver - integer,intent(out) :: g2disc,g2cat,g2num - - g2disc=255 - g2cat=255 - g2num=255 -! for testing -! g2num=g1val -! for testing - - do n=1,MAXPARAM - if ( paramlist(n)%grib1val.eq.g1val .AND. - & paramlist(n)%g1tblver.eq.g1ver ) then - g2disc=paramlist(n)%grib2dsc - g2cat=paramlist(n)%grib2cat - g2num=paramlist(n)%grib2num -c print *,g2disc -c print *,g2cat -c print *,g2num - return - endif - enddo - - print *,'param_ecmwf_g1_to_g2:GRIB1 param ',g1val, - & ' not found.', - & ' for table version ',g1ver - return - end subroutine - - - subroutine param_ecmwf_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: param_ecmwf_g2_to_g1 -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-04 -! -! ABSTRACT: This function returns the GRIB 1 parameter number for -! a given GRIB2 Discipline, Category and Parameter number. -! -! PROGRAM HISTORY LOG: -! 2001-06-05 Gilbert -! -! USAGE: call param_ecmwf_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver) -! INPUT ARGUMENT LIST: -! g2disc - GRIB2 discipline number (See Code Table 0.0) -! g2cat - corresponding GRIB2 Category number -! g2num - corresponding GRIB2 Parameter number within Category g2cat -! -! OUTPUT ARGUMENT LIST: -! g1val - GRIB1 parameter number for which discipline is requested -! g1ver - GRIB1 parameter table version number -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: g2disc,g2cat,g2num - integer,intent(out) :: g1val,g1ver - - g1val=255 - g1ver=255 - -! for testing -! if ( g2disc.eq.255.and.g2cat.eq.255 ) then -! g1val=g2num -! g1ver=2 -! return -! endif -! for testing - - do n=1,MAXPARAM - if (paramlist(n)%grib2dsc.eq.g2disc.AND. - & paramlist(n)%grib2cat.eq.g2cat.AND. - & paramlist(n)%grib2num.eq.g2num) then - g1val=paramlist(n)%grib1val - g1ver=paramlist(n)%g1tblver - return - endif - enddo - - print *,'param_ecmwf_g2_to_g1:GRIB2 param ',g2disc,g2cat, - & g2num,' not found.' - return - end subroutine - - - end module - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params_ecmwf.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params_ecmwf.mod deleted file mode 100644 index 90a1a815d1..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/params_ecmwf.mod +++ /dev/null @@ -1,57 +0,0 @@ -GFORTRAN module created from params_ecmwf.f on Mon Nov 16 16:43:03 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'gribparam' 'params_ecmwf' 1 ((DERIVED UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 ((3 'g1tblver' (INTEGER 4 ()) () 0 0 -()) (4 'grib1val' (INTEGER 4 ()) () 0 0 ()) (5 'grib2dsc' (INTEGER 4 ()) -() 0 0 ()) (6 'grib2cat' (INTEGER 4 ()) () 0 0 ()) (7 'grib2num' ( -INTEGER 4 ()) () 0 0 ()) (8 'abbrev' (CHARACTER 1 ((CONSTANT (INTEGER 4 -()) 0 '8'))) () 0 0 ())) PUBLIC ()) -9 'maxparam' 'params_ecmwf' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '177') () 0 () -()) -10 'param_ecmwf_g2_to_g1' 'params_ecmwf' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL SUBROUTINE) (UNKNOWN 0 ()) 11 0 (12 13 14 15 16) () 0 () -()) -17 'param_ecmwf_g1_to_g2' 'params_ecmwf' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL SUBROUTINE) (UNKNOWN 0 ()) 18 0 (19 20 21 22 23) () 0 () -()) -24 'params_ecmwf' 'params_ecmwf' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 () ()) -25 'paramlist' 'params_ecmwf' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN DIMENSION DATA) (DERIVED 2 ()) 0 0 () (1 EXPLICIT (CONSTANT ( -INTEGER 4 ()) 0 '1') (CONSTANT (INTEGER 4 ()) 0 '177')) 0 () ()) -22 'g2cat' '' 18 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -21 'g2disc' '' 18 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 -()) 0 0 () () 0 () ()) -20 'g1ver' '' 18 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -23 'g2num' '' 18 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -12 'g2disc' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -19 'g1val' '' 18 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -14 'g2num' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -15 'g1val' '' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -13 'g2cat' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -16 'g1ver' '' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -) - -('paramlist' 0 25 'param_ecmwf_g1_to_g2' 0 17 'maxparam' 0 9 'gribparam' -0 2 'param_ecmwf_g2_to_g1' 0 10 'params_ecmwf' 0 24) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pdstemplates.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pdstemplates.f deleted file mode 100755 index 44e91d5ea5..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pdstemplates.f +++ /dev/null @@ -1,494 +0,0 @@ - module pdstemplates -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! MODULE: pdstemplates -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11 -! -! ABSTRACT: This Fortran Module contains info on all the available -! GRIB2 Product Definition Templates used in Section 4 (PDS). -! Each Template has three parts: The number of entries in the template -! (mapgridlen); A map of the template (mapgrid), which contains the -! number of octets in which to pack each of the template values; and -! a logical value (needext) that indicates whether the Template needs -! to be extended. In some cases the number of entries in a template -! can vary depending upon values specified in the "static" part of -! the template. ( See Template 4.3 as an example ) -! -! This module also contains two subroutines. Subroutine getpdstemplate -! returns the octet map for a specified Template number, and -! subroutine extpdstemplate will calculate the extended octet map -! of an appropriate template given values for the "static" part of the -! template. See docblocks below for the arguments and usage of these -! routines. -! -! NOTE: Array mapgrid contains the number of octets in which the -! corresponding template values will be stored. A negative value in -! mapgrid is used to indicate that the corresponding template entry can -! contain negative values. This information is used later when packing -! (or unpacking) the template data values. Negative data values in GRIB -! are stored with the left most bit set to one, and a negative number -! of octets value in mapgrid() indicates that this possibility should -! be considered. The number of octets used to store the data value -! in this case would be the absolute value of the negative value in -! mapgrid(). -! -! -! PROGRAM HISTORY LOG: -! 2000-05-11 Gilbert -! 2001-12-04 Gilbert - Added Templates 4.12, 4.12, 4.14, -! 4.1000, 4.1001, 4.1002, 4.1100 and 4.1101 -! -! USAGE: use pdstemplates -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,parameter :: MAXLEN=200,MAXTEMP=23 - - type pdstemplate - integer :: template_num - integer :: mappdslen - integer,dimension(MAXLEN) :: mappds - logical :: needext - end type pdstemplate - - type(pdstemplate),dimension(MAXTEMP) :: templates - - data templates(1)%template_num /0/ ! Fcst at Level/Layer - data templates(1)%mappdslen /15/ - data templates(1)%needext /.false./ - data (templates(1)%mappds(j),j=1,15) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/ - - data templates(2)%template_num /1/ ! Ens fcst at level/layer - data templates(2)%mappdslen /18/ - data templates(2)%needext /.false./ - data (templates(2)%mappds(j),j=1,18) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/ - - data templates(3)%template_num /2/ ! Derived Ens fcst at level/layer - data templates(3)%mappdslen /17/ - data templates(3)%needext /.false./ - data (templates(3)%mappds(j),j=1,17) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1/ - - data templates(4)%template_num /3/ ! Ens cluster fcst rect. area - data templates(4)%mappdslen /31/ - data templates(4)%needext /.true./ - data (templates(4)%mappds(j),j=1,31) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4, - & 1,-1,4,-1,4/ - - data templates(5)%template_num /4/ ! Ens cluster fcst circ. area - data templates(5)%mappdslen /30/ - data templates(5)%needext /.true./ - data (templates(5)%mappds(j),j=1,30) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4, - & 1,-1,4,-1,4/ - - data templates(6)%template_num /5/ ! Prob fcst at level/layer - data templates(6)%mappdslen /22/ - data templates(6)%needext /.false./ - data (templates(6)%mappds(j),j=1,22) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,4,1,4/ - - data templates(7)%template_num /6/ ! Percentile fcst at level/layer - data templates(7)%mappdslen /16/ - data templates(7)%needext /.false./ - data (templates(7)%mappds(j),j=1,16) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1/ - - data templates(8)%template_num /7/ ! Error at level/layer - data templates(8)%mappdslen /15/ - data templates(8)%needext /.false./ - data (templates(8)%mappds(j),j=1,15) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/ - - data templates(9)%template_num /8/ ! Ave or Accum at level/layer - data templates(9)%mappdslen /29/ - data templates(9)%needext /.true./ - data (templates(9)%mappds(j),j=1,29) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/ - - data templates(10)%template_num /9/ ! Prob over time interval - data templates(10)%mappdslen /36/ - data templates(10)%needext /.true./ - data (templates(10)%mappds(j),j=1,36) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,-1,4,-1,4,2,1,1,1,1,1, - & 1,4,1,1,1,4,1,4/ - - data templates(11)%template_num /10/ ! Percentile over time interval - data templates(11)%mappdslen /30/ - data templates(11)%needext /.true./ - data (templates(11)%mappds(j),j=1,30) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,2,1,1,1,1,1,1,4, - & 1,1,1,4,1,4/ - - data templates(12)%template_num /11/ ! Ens member over time interval - data templates(12)%mappdslen /32/ - data templates(12)%needext /.true./ - data (templates(12)%mappds(j),j=1,32) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1, - & 4,1,1,1,4,1,4/ - - data templates(13)%template_num /12/ ! Derived Ens fcst over time int - data templates(13)%mappdslen /31/ - data templates(13)%needext /.true./ - data (templates(13)%mappds(j),j=1,31) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1, - & 2,1,1,1,1,1,1,4,1,1,1,4,1,4/ - - data templates(14)%template_num /13/ ! Ens cluster fcst rect. area - data templates(14)%mappdslen /45/ - data templates(14)%needext /.true./ - data (templates(14)%mappds(j),j=1,45) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4, - & 1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/ - - data templates(15)%template_num /14/ ! Ens cluster fcst circ. area - data templates(15)%mappdslen /44/ - data templates(15)%needext /.true./ - data (templates(15)%mappds(j),j=1,44) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4, - & 1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/ - - data templates(16)%template_num /20/ ! Radar Product - data templates(16)%mappdslen /19/ - data templates(16)%needext /.false./ - data (templates(16)%mappds(j),j=1,19) - & /1,1,1,1,1,-4,4,2,4,2,1,1,1,1,1,2,1,3,2/ - - data templates(17)%template_num /30/ ! Satellite Product - data templates(17)%mappdslen /5/ - data templates(17)%needext /.true./ - data (templates(17)%mappds(j),j=1,5) - & /1,1,1,1,1/ - - data templates(18)%template_num /254/ ! CCITTIA5 Character String - data templates(18)%mappdslen /3/ - data templates(18)%needext /.false./ - data (templates(18)%mappds(j),j=1,3) - & /1,1,4/ - - data templates(19)%template_num /1000/ ! Cross section - data templates(19)%mappdslen /9/ - data templates(19)%needext /.false./ - data (templates(19)%mappds(j),j=1,9) - & /1,1,1,1,1,2,1,1,4/ - - data templates(20)%template_num /1001/ ! Cross section over time - data templates(20)%mappdslen /16/ - data templates(20)%needext /.false./ - data (templates(20)%mappds(j),j=1,16) - & /1,1,1,1,1,2,1,1,4,4,1,1,1,4,1,4/ - - data templates(21)%template_num /1002/ ! Cross section processed time - data templates(21)%mappdslen /15/ - data templates(21)%needext /.false./ - data (templates(21)%mappds(j),j=1,15) - & /1,1,1,1,1,2,1,1,4,1,1,1,4,4,2/ - - data templates(22)%template_num /1100/ ! Hovmoller grid - data templates(22)%mappdslen /15/ - data templates(22)%needext /.false./ - data (templates(22)%mappds(j),j=1,15) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/ - - data templates(23)%template_num /1101/ ! Hovmoller with stat proc - data templates(23)%mappdslen /22/ - data templates(23)%needext /.false./ - data (templates(23)%mappds(j),j=1,22) - & /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4/ - - - contains - - integer function getpdsindex(number) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getpdsindex -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28 -! -! ABSTRACT: This function returns the index of specified Product -! Definition Template 4.NN (NN=number) in array templates. -! -! PROGRAM HISTORY LOG: -! 2001-06-28 Gilbert -! -! USAGE: index=getpdsindex(number) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Product Definition -! Template 4.NN that is being requested. -! -! RETURNS: Index of PDT 4.NN in array templates, if template exists. -! = -1, otherwise. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number - - getpdsindex=-1 - - do j=1,MAXTEMP - if (number.eq.templates(j)%template_num) then - getpdsindex=j - return - endif - enddo - - end function - - - - - subroutine getpdstemplate(number,nummap,map,needext,iret) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getpdstemplate -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11 -! -! ABSTRACT: This subroutine returns PDS template information for a -! specified Product Definition Template 4.NN. -! The number of entries in the template is returned along with a map -! of the number of octets occupied by each entry. Also, a flag is -! returned to indicate whether the template would need to be extended. -! -! PROGRAM HISTORY LOG: -! 2000-05-11 Gilbert -! -! USAGE: CALL getpdstemplate(number,nummap,map,needext,iret) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Product Definition -! Template 4.NN that is being requested. -! -! OUTPUT ARGUMENT LIST: -! nummap - Number of entries in the Template -! map() - An array containing the number of octets that each -! template entry occupies when packed up into the PDS. -! needext - Logical variable indicating whether the Product Defintion -! Template has to be extended. -! ierr - Error return code. -! 0 = no error -! 1 = Undefine Product Template number. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number - integer,intent(out) :: nummap,map(*),iret - logical,intent(out) :: needext - - iret=0 - - index=getpdsindex(number) - - if (index.ne.-1) then - nummap=templates(index)%mappdslen - needext=templates(index)%needext - map(1:nummap)=templates(index)%mappds(1:nummap) - else - nummap=0 - needext=.false. - print *,'getpdstemplate: PDS Template ',number, - & ' not defined.' - iret=1 - endif - - end subroutine - - subroutine extpdstemplate(number,list,nummap,map) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: extpdstemplate -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11 -! -! ABSTRACT: This subroutine generates the remaining octet map for a -! given Product Definition Template, if required. Some Templates can -! vary depending on data values given in an earlier part of the -! Template, and it is necessary to know some of the earlier entry -! values to generate the full octet map of the Template. -! -! PROGRAM HISTORY LOG: -! 2000-05-11 Gilbert -! -! USAGE: CALL extpdstemplate(number,list,nummap,map) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Product Definition -! Template 4.NN that is being requested. -! list() - The list of values for each entry in the -! the Product Definition Template 4.NN. -! -! OUTPUT ARGUMENT LIST: -! nummap - Number of entries in the Template -! map() - An array containing the number of octets that each -! template entry occupies when packed up into the GDS. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number,list(*) - integer,intent(out) :: nummap,map(*) - - index=getpdsindex(number) - if (index.eq.-1) return - - if ( .not. templates(index)%needext ) return - nummap=templates(index)%mappdslen - map(1:nummap)=templates(index)%mappds(1:nummap) - - if ( number.eq.3 ) then - N=list(27) - do i=1,N - map(nummap+i)=1 - enddo - nummap=nummap+N - elseif ( number.eq.4 ) then - N=list(26) - do i=1,N - map(nummap+i)=1 - enddo - nummap=nummap+N - elseif ( number.eq.8 ) then - if ( list(22).gt.1 ) then - do j=2,list(22) - do k=1,6 - map(nummap+k)=map(23+k) - enddo - nummap=nummap+6 - enddo - endif - elseif ( number.eq.9 ) then - if ( list(29).gt.1 ) then - do j=2,list(29) - do k=1,6 - map(nummap+k)=map(30+k) - enddo - nummap=nummap+6 - enddo - endif - elseif ( number.eq.10 ) then - if ( list(23).gt.1 ) then - do j=2,list(23) - do k=1,6 - map(nummap+k)=map(24+k) - enddo - nummap=nummap+6 - enddo - endif - elseif ( number.eq.11 ) then - if ( list(25).gt.1 ) then - do j=2,list(25) - do k=1,6 - map(nummap+k)=map(26+k) - enddo - nummap=nummap+6 - enddo - endif - elseif ( number.eq.12 ) then - if ( list(24).gt.1 ) then - do j=2,list(24) - do k=1,6 - map(nummap+k)=map(25+k) - enddo - nummap=nummap+6 - enddo - endif - elseif ( number.eq.13 ) then - if ( list(38).gt.1 ) then - do j=2,list(38) - do k=1,6 - map(nummap+k)=map(39+k) - enddo - nummap=nummap+6 - enddo - endif - N=list(27) - do i=1,N - map(nummap+i)=1 - enddo - nummap=nummap+N - elseif ( number.eq.14 ) then - if ( list(37).gt.1 ) then - do j=2,list(37) - do k=1,6 - map(nummap+k)=map(38+k) - enddo - nummap=nummap+6 - enddo - endif - N=list(26) - do i=1,N - map(nummap+i)=1 - enddo - nummap=nummap+N - elseif ( number.eq.30 ) then - do j=1,list(5) - map(nummap+1)=2 - map(nummap+2)=2 - map(nummap+3)=1 - map(nummap+4)=1 - map(nummap+5)=4 - nummap=nummap+5 - enddo - endif - - end subroutine - - integer function getpdtlen(number) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: getpdtlen -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-05-11 -! -! ABSTRACT: This function returns the initial length (number of entries) in -! the "static" part of specified Product Definition Template 4.number. -! -! PROGRAM HISTORY LOG: -! 2004-05-11 Gilbert -! -! USAGE: CALL getpdtlen(number) -! INPUT ARGUMENT LIST: -! number - NN, indicating the number of the Product Definition -! Template 4.NN that is being requested. -! -! RETURNS: Number of entries in the "static" part of PDT 4.number -! OR returns 0, if requested template is not found. -! -! REMARKS: If user needs the full length of a specific template that -! contains additional entries based on values set in the "static" part -! of the PDT, subroutine extpdstemplate can be used. -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - integer,intent(in) :: number - - getpdtlen=0 - - index=getpdsindex(number) - - if (index.ne.-1) then - getpdtlen=templates(index)%mappdslen - endif - - end function - - - end module - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pdstemplates.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pdstemplates.mod deleted file mode 100644 index 8851584ada..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pdstemplates.mod +++ /dev/null @@ -1,70 +0,0 @@ -GFORTRAN module created from pdstemplates.f on Mon Nov 16 16:42:52 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'extpdstemplate' 'pdstemplates' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL SUBROUTINE) (UNKNOWN 0 ()) 3 0 (4 5 6 7) () 0 () ()) -8 'getpdsindex' 'pdstemplates' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL FUNCTION) (INTEGER 4 ()) 9 0 (10) () 8 () ()) -11 'getpdtlen' 'pdstemplates' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC -DECL FUNCTION) (INTEGER 4 ()) 12 0 (13) () 11 () ()) -14 'maxlen' 'pdstemplates' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '200') () 0 () -()) -15 'maxtemp' 'pdstemplates' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '23') () 0 () -()) -16 'templates' 'pdstemplates' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN DIMENSION DATA) (DERIVED 17 ()) 0 0 () (1 EXPLICIT (CONSTANT ( -INTEGER 4 ()) 0 '1') (CONSTANT (INTEGER 4 ()) 0 '23')) 0 () ()) -18 'pdstemplates' 'pdstemplates' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 () ()) -17 'pdstemplate' 'pdstemplates' 1 ((DERIVED UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 ((19 'template_num' (INTEGER 4 ()) () -0 0 ()) (20 'mappdslen' (INTEGER 4 ()) () 0 0 ()) (21 'mappds' (INTEGER -4 ()) (1 EXPLICIT (CONSTANT (INTEGER 4 ()) 0 '1') (CONSTANT (INTEGER 4 ()) -0 '200')) 1 0 ()) (22 'needext' (LOGICAL 4 ()) () 0 0 ())) PUBLIC ()) -23 'j' 'pdstemplates' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(INTEGER 4 ()) 0 0 () () 0 () ()) -24 'getpdstemplate' 'pdstemplates' 1 ((PROCEDURE UNKNOWN-INTENT -MODULE-PROC DECL SUBROUTINE) (UNKNOWN 0 ()) 25 0 (26 27 28 29 30) () 0 () -()) -10 'number' '' 9 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -27 'nummap' '' 25 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 -()) 0 0 () () 0 () ()) -26 'number' '' 25 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -28 'map' '' 25 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -30 'iret' '' 25 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -5 'list' '' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -29 'needext' '' 25 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (LOGICAL 4 -()) 0 0 () () 0 () ()) -6 'nummap' '' 3 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -4 'number' '' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -13 'number' '' 12 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -7 'map' '' 3 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DIMENSION DUMMY) ( -INTEGER 4 ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 ()) 0 '1') ()) -0 () ()) -) - -('getpdstemplate' 0 24 'getpdsindex' 0 8 'extpdstemplate' 0 2 'j' 0 23 -'getpdtlen' 0 11 'pdstemplate' 0 17 'maxtemp' 0 15 'maxlen' 0 14 -'pdstemplates' 0 18 'templates' 0 16) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pngpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pngpack.f deleted file mode 100755 index 77a394ac5a..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pngpack.f +++ /dev/null @@ -1,160 +0,0 @@ - subroutine pngpack(fld,width,height,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: pngpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-21 -! -! ABSTRACT: This subroutine packs up a data field into PNG image format. -! After the data field is scaled, and the reference value is subtracted out, -! it is treated as a grayscale image and passed to a PNG encoder. -! It also fills in GRIB2 Data Representation Template 5.41 or 5.40010 with the -! appropriate values. -! -! PROGRAM HISTORY LOG: -! 2002-12-21 Gilbert -! -! USAGE: CALL pngpack(fld,width,height,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the data values to pack -! width - number of points in the x direction -! height - number of points in the y direction -! idrstmpl - Contains the array of values for Data Representation -! Template 5.41 or 5.40010 -! (1) = Reference value - ignored on input -! (2) = Binary Scale Factor -! (3) = Decimal Scale Factor -! (4) = number of bits for each data value - ignored on input -! (5) = Original field type - currently ignored on input -! Data values assumed to be reals. -! -! OUTPUT ARGUMENT LIST: -! idrstmpl - Contains the array of values for Data Representation -! Template 5.41 or 5.40010 -! (1) = Reference value - set by pngpack routine. -! (2) = Binary Scale Factor - unchanged from input -! (3) = Decimal Scale Factor - unchanged from input -! (4) = Number of bits containing each grayscale pixel value -! (5) = Original field type - currently set = 0 on output. -! Data values assumed to be reals. -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,intent(in) :: width,height - real,intent(in) :: fld(width*height) - character(len=1),intent(out) :: cpack(*) - integer,intent(inout) :: idrstmpl(*) - integer,intent(out) :: lcpack - - real(4) :: ref,rmin4 - real(8) :: rmin,rmax - integer(4) :: iref - integer :: ifld(width*height) - integer,parameter :: zero=0 - integer :: enc_png - character(len=1),allocatable :: ctemp(:) - - ndpts=width*height - bscale=2.0**real(-idrstmpl(2)) - dscale=10.0**real(idrstmpl(3)) -! -! Find max and min values in the data -! - rmax=fld(1) - rmin=fld(1) - do j=2,ndpts - if (fld(j).gt.rmax) rmax=fld(j) - if (fld(j).lt.rmin) rmin=fld(j) - enddo - maxdif=nint((rmax-rmin)*dscale*bscale) -! -! If max and min values are not equal, pack up field. -! If they are equal, we have a constant field, and the reference -! value (rmin) is the value for each point in the field and -! set nbits to 0. -! - if (rmin.ne.rmax .AND. maxdif.ne.0) then - ! - ! Determine which algorithm to use based on user-supplied - ! binary scale factor and number of bits. - ! - if (idrstmpl(2).eq.0) then - ! - ! No binary scaling and calculate minimum number of - ! bits in which the data will fit. - ! - imin=nint(rmin*dscale) - imax=nint(rmax*dscale) - maxdif=imax-imin - temp=alog(real(maxdif+1))/alog(2.0) - nbits=ceiling(temp) - rmin=real(imin) - ! scale data - do j=1,ndpts - ifld(j)=nint(fld(j)*dscale)-imin - enddo - else - ! - ! Use binary scaling factor and calculate minimum number of - ! bits in which the data will fit. - ! - rmin=rmin*dscale - rmax=rmax*dscale - maxdif=nint((rmax-rmin)*bscale) - temp=alog(real(maxdif+1))/alog(2.0) - nbits=ceiling(temp) - ! scale data - do j=1,ndpts - ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale) - enddo - endif - ! - ! Pack data into full octets, then do PNG encode. - ! and calculate the length of the packed data in bytes - ! - if (nbits.le.8) then - nbits=8 - elseif (nbits.le.16) then - nbits=16 - elseif (nbits.le.24) then - nbits=24 - else - nbits=32 - endif - nbytes=(nbits/8)*ndpts - allocate(ctemp(nbytes)) - call sbytes(ctemp,ifld,0,nbits,0,ndpts) - ! - ! Encode data into PNG Format. - ! - lcpack=enc_png(ctemp,width,height,nbits,cpack) - if (lcpack.le.0) then - print *,'pngpack: ERROR Encoding PNG = ',lcpack - endif - deallocate(ctemp) - - else - nbits=0 - lcpack=0 - endif - -! -! Fill in ref value and number of bits in Template 5.0 -! - rmin4=rmin - call mkieee(rmin4,ref,1) ! ensure reference value is IEEE format -! call gbyte(ref,idrstmpl(1),0,32) - iref=transfer(ref,iref) - idrstmpl(1)=iref - idrstmpl(4)=nbits - idrstmpl(5)=0 ! original data were reals - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pngunpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pngunpack.f deleted file mode 100755 index e74ae4e991..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/pngunpack.f +++ /dev/null @@ -1,70 +0,0 @@ - subroutine pngunpack(cpack,len,idrstmpl,ndpts,fld) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: pngunpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21 -! -! ABSTRACT: This subroutine unpacks a data field that was packed into a -! PNG image format -! using info from the GRIB2 Data Representation Template 5.41 or 5.40010. -! -! PROGRAM HISTORY LOG: -! 2000-06-21 Gilbert -! -! USAGE: CALL pngunpack(cpack,len,idrstmpl,ndpts,fld) -! INPUT ARGUMENT LIST: -! cpack - The packed data field (character*1 array) -! len - length of packed field cpack(). -! idrstmpl - Contains the array of values for Data Representation -! Template 5.41 or 5.40010 -! ndpts - The number of data values to unpack -! -! OUTPUT ARGUMENT LIST: -! fld() - Contains the unpacked data values -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cpack(len) - integer,intent(in) :: ndpts,len - integer,intent(in) :: idrstmpl(*) - real,intent(out) :: fld(ndpts) - - integer :: ifld(ndpts) - character(len=1),allocatable :: ctemp(:) - integer(4) :: ieee - real :: ref,bscale,dscale - integer :: dec_png,width,height - - ieee = idrstmpl(1) - call rdieee(ieee,ref,1) - bscale = 2.0**real(idrstmpl(2)) - dscale = 10.0**real(-idrstmpl(3)) - nbits = idrstmpl(4) - itype = idrstmpl(5) -! -! if nbits equals 0, we have a constant field where the reference value -! is the data value at each gridpoint -! - if (nbits.ne.0) then - allocate(ctemp(ndpts*4)) - iret=dec_png(cpack,width,height,ctemp) - call gbytes(ctemp,ifld,0,nbits,0,ndpts) - deallocate(ctemp) - do j=1,ndpts - fld(j)=((real(ifld(j))*bscale)+ref)*dscale - enddo - else - do j=1,ndpts - fld(j)=ref - enddo - endif - - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/putgb2.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/putgb2.f deleted file mode 100755 index a93714274b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/putgb2.f +++ /dev/null @@ -1,273 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGB2(LUGB,GFLD,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGB2 PACKS AND WRITES A GRIB2 MESSAGE -C PRGMMR: GILBERT ORG: W/NP11 DATE: 2002-04-22 -C -C ABSTRACT: PACKS A SINGLE FIELD INTO A GRIB2 MESSAGE -C AND WRITES OUT THAT MESSAGE TO THE FILE ASSOCIATED WITH UNIT LUGB. -C NOTE THAT FILE/UNIT LUGB SHOULD BE OPENED WOTH A CALL TO -C SUBROUTINE BAOPENW BEFORE THIS ROUTINE IS CALLED. -C -C The information to be packed into the GRIB field -C is stored in a derived type variable, gfld. -C Gfld is of type gribfield, which is defined -C in module grib_mod, so users of this routine will need to include -C the line "USE GRIB_MOD" in their calling routine. Each component of the -C gribfield type is described in the INPUT ARGUMENT LIST section below. -C -C PROGRAM HISTORY LOG: -C 2002-04-22 GILBERT -C 2005-02-28 GILBERT - Changed dimension of array cgrib to be a multiple -C of gfld%ngrdpts instead of gfld%ndpts. -C -C USAGE: CALL PUTGB2(LUGB,GFLD,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE. -C FILE MUST BE OPENED WITH BAOPEN OR BAOPENW BEFORE CALLING -C THIS ROUTINE. -C gfld - derived type gribfield ( defined in module grib_mod ) -C ( NOTE: See Remarks Section ) -C gfld%version = GRIB edition number ( currently 2 ) -C gfld%discipline = Message Discipline ( see Code Table 0.0 ) -C gfld%idsect() = Contains the entries in the Identification -C Section ( Section 1 ) -C This element is actually a pointer to an array -C that holds the data. -C gfld%idsect(1) = Identification of originating Centre -C ( see Common Code Table C-1 ) -C 7 - US National Weather Service -C gfld%idsect(2) = Identification of originating Sub-centre -C gfld%idsect(3) = GRIB Master Tables Version Number -C ( see Code Table 1.0 ) -C 0 - Experimental -C 1 - Initial operational version number -C gfld%idsect(4) = GRIB Local Tables Version Number -C ( see Code Table 1.1 ) -C 0 - Local tables not used -C 1-254 - Number of local tables version used -C gfld%idsect(5) = Significance of Reference Time (Code Table 1.2) -C 0 - Analysis -C 1 - Start of forecast -C 2 - Verifying time of forecast -C 3 - Observation time -C gfld%idsect(6) = Year ( 4 digits ) -C gfld%idsect(7) = Month -C gfld%idsect(8) = Day -C gfld%idsect(9) = Hour -C gfld%idsect(10) = Minute -C gfld%idsect(11) = Second -C gfld%idsect(12) = Production status of processed data -C ( see Code Table 1.3 ) -C 0 - Operational products -C 1 - Operational test products -C 2 - Research products -C 3 - Re-analysis products -C gfld%idsect(13) = Type of processed data ( see Code Table 1.4 ) -C 0 - Analysis products -C 1 - Forecast products -C 2 - Analysis and forecast products -C 3 - Control forecast products -C 4 - Perturbed forecast products -C 5 - Control and perturbed forecast products -C 6 - Processed satellite observations -C 7 - Processed radar observations -C gfld%idsectlen = Number of elements in gfld%idsect(). -C gfld%local() = Pointer to character array containing contents -C of Local Section 2, if included -C gfld%locallen = length of array gfld%local() -C gfld%ifldnum = field number within GRIB message -C gfld%griddef = Source of grid definition (see Code Table 3.0) -C 0 - Specified in Code table 3.1 -C 1 - Predetermined grid Defined by originating centre -C gfld%ngrdpts = Number of grid points in the defined grid. -C gfld%numoct_opt = Number of octets needed for each -C additional grid points definition. -C Used to define number of -C points in each row ( or column ) for -C non-regular grids. -C = 0, if using regular grid. -C gfld%interp_opt = Interpretation of list for optional points -C definition. (Code Table 3.11) -C gfld%igdtnum = Grid Definition Template Number (Code Table 3.1) -C gfld%igdtmpl() = Contains the data values for the specified Grid -C Definition Template ( NN=gfld%igdtnum ). Each -C element of this integer array contains an entry (in -C the order specified) of Grid Defintion Template 3.NN -C This element is actually a pointer to an array -C that holds the data. -C gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of -C entries in Grid Defintion Template 3.NN -C ( NN=gfld%igdtnum ). -C gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array -C contains the number of grid points contained in -C each row ( or column ). (part of Section 3) -C This element is actually a pointer to an array -C that holds the data. This pointer is nullified -C if gfld%numoct_opt=0. -C gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries -C in array ideflist. i.e. number of rows ( or columns ) -C for which optional grid points are defined. This value -C is set to zero, if gfld%numoct_opt=0. -C gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0) -C gfld%ipdtmpl() = Contains the data values for the specified Product -C Definition Template ( N=gfdl%ipdtnum ). Each element -C of this integer array contains an entry (in the -C order specified) of Product Defintion Template 4.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of -C entries in Product Defintion Template 4.N -C ( N=gfdl%ipdtnum ). -C gfld%coord_list() = Real array containing floating point values -C intended to document the vertical discretisation -C associated to model data on hybrid coordinate -C vertical levels. (part of Section 4) -C This element is actually a pointer to an array -C that holds the data. -C gfld%num_coord = number of values in array gfld%coord_list(). -C gfld%ndpts = Number of data points unpacked and returned. -C gfld%idrtnum = Data Representation Template Number -C ( see Code Table 5.0) -C gfld%idrtmpl() = Contains the data values for the specified Data -C Representation Template ( N=gfld%idrtnum ). Each -C element of this integer array contains an entry -C (in the order specified) of Product Defintion -C Template 5.N. -C This element is actually a pointer to an array -C that holds the data. -C gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number -C of entries in Data Representation Template 5.N -C ( N=gfld%idrtnum ). -C gfld%unpacked = logical value indicating whether the bitmap and -C data values were unpacked. If false, -C gfld%bmap and gfld%fld pointers are nullified. -C gfld%ibmap = Bitmap indicator ( see Code Table 6.0 ) -C 0 = bitmap applies and is included in Section 6. -C 1-253 = Predefined bitmap applies -C 254 = Previously defined bitmap applies to this field -C 255 = Bit map does not apply to this product. -C gfld%bmap() = Logical*1 array containing decoded bitmap, -C if ibmap=0 or ibap=254. Otherwise nullified. -C This element is actually a pointer to an array -C that holds the data. -C gfld%fld() = Array of gfld%ndpts unpacked data points. -C This element is actually a pointer to an array -C that holds the data. -C -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 2 MEMORY ALLOCATION ERROR -C 10 No Section 1 info available -C 11 No Grid Definition Template info available -C 12 Missing some required data field info -C -C SUBPROGRAMS CALLED: -C gribcreate Start a new grib2 message -C addlocal Add local section to a GRIB2 message -C addgrid Add grid info to a GRIB2 message -C addfield Add data field to a GRIB2 message -C gribend End GRIB2 message -C -C REMARKS: -C -C Note that derived type gribfield contains pointers to many -C arrays of data. The memory for these arrays is allocated -C when the values in the arrays are set, to help minimize -C problems with array overloading. Because of this users -C are encouraged to free up this memory, when it is no longer -C needed, by an explicit call to subroutine gf_free. -C ( i.e. CALL GF_FREE(GFLD) ) -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE GRIB_MOD - - INTEGER,INTENT(IN) :: LUGB - TYPE(GRIBFIELD),INTENT(IN) :: GFLD - INTEGER,INTENT(OUT) :: IRET - - CHARACTER(LEN=1),ALLOCATABLE,DIMENSION(:) :: CGRIB - integer :: listsec0(2)=(/0,2/) - integer :: igds(5)=(/0,0,0,0,0/) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C ALLOCATE ARRAY FOR GRIB2 FIELD - lcgrib=gfld%ngrdpts*4 - allocate(cgrib(lcgrib),stat=is) - if ( is.ne.0 ) then - print *,'putgb2: cannot allocate memory. ',is - iret=2 - endif -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CREATE NEW MESSAGE - listsec0(1)=gfld%discipline - listsec0(2)=gfld%version - if ( associated(gfld%idsect) ) then - call gribcreate(cgrib,lcgrib,listsec0,gfld%idsect,ierr) - if (ierr.ne.0) then - write(6,*) 'putgb2: ERROR creating new GRIB2 field = ',ierr - endif - else - print *,'putgb2: No Section 1 info available. ' - iret=10 - deallocate(cgrib) - return - endif -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C ADD LOCAL USE SECTION TO GRIB2 MESSAGE - if ( associated(gfld%local).AND.gfld%locallen.gt.0 ) then - call addlocal(cgrib,lcgrib,gfld%local,gfld%locallen,ierr) - if (ierr.ne.0) then - write(6,*) 'putgb2: ERROR adding local info = ',ierr - endif - endif -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C ADD GRID TO GRIB2 MESSAGE - igds(1)=gfld%griddef - igds(2)=gfld%ngrdpts - igds(3)=gfld%numoct_opt - igds(4)=gfld%interp_opt - igds(5)=gfld%igdtnum - if ( associated(gfld%igdtmpl) ) then - call addgrid(cgrib,lcgrib,igds,gfld%igdtmpl,gfld%igdtlen, - & gfld%list_opt,gfld%num_opt,ierr) - if (ierr.ne.0) then - write(6,*) 'putgb2: ERROR adding grid info = ',ierr - endif - else - print *,'putgb2: No GDT info available. ' - iret=11 - deallocate(cgrib) - return - endif -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C ADD DATA FIELD TO GRIB2 MESSAGE - if ( associated(gfld%ipdtmpl).AND. - & associated(gfld%idrtmpl).AND. - & associated(gfld%fld) ) then - call addfield(cgrib,lcgrib,gfld%ipdtnum,gfld%ipdtmpl, - & gfld%ipdtlen,gfld%coord_list,gfld%num_coord, - & gfld%idrtnum,gfld%idrtmpl,gfld%idrtlen, - & gfld%fld,gfld%ngrdpts,gfld%ibmap,gfld%bmap, - & ierr) - if (ierr.ne.0) then - write(6,*) 'putgb2: ERROR adding data field = ',ierr - endif - else - print *,'putgb2: Missing some field info. ' - iret=12 - deallocate(cgrib) - return - endif -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CLOSE GRIB2 MESSAGE AND WRITE TO FILE - call gribend(cgrib,lcgrib,lengrib,ierr) - call wryte(lugb,lengrib,cgrib) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - deallocate(cgrib) - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/rdieee.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/rdieee.f deleted file mode 100755 index 3ec4eb6ffb..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/rdieee.f +++ /dev/null @@ -1,79 +0,0 @@ - subroutine rdieee(rieee,a,num) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: rdieee -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09 -! -! ABSTRACT: This subroutine reads a list of real values in -! 32-bit IEEE floating point format. -! -! PROGRAM HISTORY LOG: -! 2000-05-09 Gilbert -! -! USAGE: CALL rdieee(rieee,a,num) -! INPUT ARGUMENT LIST: -! rieee - Input array of floating point values in 32-bit IEEE format. -! num - Number of floating point values to convert. -! -! OUTPUT ARGUMENT LIST: -! a - Output array of real values. -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - real(4),intent(in) :: rieee(num) - real,intent(out) :: a(num) - integer,intent(in) :: num - - integer(4) :: ieee - - real,save :: two23 - real,save :: two126 - integer,save :: once=0 - - if ( once .EQ. 0 ) then - once=1 - two23=scale(1.0,-23) - two126=scale(1.0,-126) - endif - - do j=1,num -! -! Transfer IEEE bit string to integer variable -! - ieee=transfer(rieee(j),ieee) -! -! Extract sign bit, exponent, and mantissa -! - isign=ibits(ieee,31,1) - iexp=ibits(ieee,23,8) - imant=ibits(ieee,0,23) - sign=1.0 - if (isign.eq.1) sign=-1.0 - - if ( (iexp.gt.0).and.(iexp.lt.255) ) then - temp=2.0**(iexp-127) - a(j)=sign*temp*(1.0+(two23*real(imant))) - - elseif ( iexp.eq.0 ) then - if ( imant.ne.0 ) then - a(j)=sign*two126*two23*real(imant) - else - a(j)=sign*0.0 - endif - - elseif ( iexp.eq.255 ) then - a(j)=sign*huge(a(j)) - - endif - - enddo - - return - end - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/re_alloc.mod b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/re_alloc.mod deleted file mode 100644 index 475d7bfec4..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/re_alloc.mod +++ /dev/null @@ -1,49 +0,0 @@ -GFORTRAN module created from realloc.f on Mon Nov 16 16:42:53 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -(('realloc' '' 2 3 4)) - -() - -() - -(5 're_alloc' 're_alloc' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN) -(UNKNOWN 0 ()) 0 0 () () 0 () ()) -4 'realloc_c1' 're_alloc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL -SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 ()) 6 0 (7 8 9 10) () 0 () ()) -3 'realloc_r' 're_alloc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL -SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 ()) 11 0 (12 13 14 15) () 0 () ()) -2 'realloc_i' 're_alloc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL -SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 ()) 16 0 (17 18 19 20) () 0 () ()) -10 'istat' '' 6 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -9 'm' '' 6 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) 0 0 -() () 0 () ()) -12 'c' '' 11 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN DIMENSION -POINTER DUMMY) (REAL 4 ()) 0 0 () (1 DEFERRED () ()) 0 () ()) -14 'm' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) 0 -0 () () 0 () ()) -13 'n' '' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) 0 -0 () () 0 () ()) -7 'c' '' 6 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN DIMENSION -POINTER DUMMY) (CHARACTER 1 ((CONSTANT (INTEGER 4 ()) 0 '1'))) 0 0 () ( -1 DEFERRED () ()) 0 () ()) -8 'n' '' 6 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) 0 0 -() () 0 () ()) -17 'c' '' 16 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN DIMENSION -POINTER DUMMY) (INTEGER 4 ()) 0 0 () (1 DEFERRED () ()) 0 () ()) -18 'n' '' 16 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) 0 -0 () () 0 () ()) -19 'm' '' 16 ((VARIABLE IN UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) 0 -0 () () 0 () ()) -20 'istat' '' 16 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -15 'istat' '' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN DUMMY) (INTEGER 4 ()) -0 0 () () 0 () ()) -) - -('realloc_i' 0 2 're_alloc' 0 5 'realloc_c1' 0 4 'realloc_r' 0 3) diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/realloc.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/realloc.f deleted file mode 100755 index 254ca54822..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/realloc.f +++ /dev/null @@ -1,125 +0,0 @@ - module re_alloc - - interface realloc - module procedure realloc_c1 - module procedure realloc_r - module procedure realloc_i -!! subroutine realloc_c1(c,n,m,istat) -!! character(len=1),pointer,dimension(:) :: c -!! integer :: n,m -!! integer :: istat -!! end subroutine -!! subroutine realloc_r(c,n,m,istat) -!! real,pointer,dimension(:) :: c -!! integer :: n,m -!! integer :: istat -!! end subroutine -!! subroutine realloc_i(c,n,m,istat) -!! integer,pointer,dimension(:) :: c -!! integer :: n,m -!! integer :: istat -!! end subroutine - end interface - - contains - - subroutine realloc_c1(c,n,m,istat) - character(len=1),pointer,dimension(:) :: c - integer,intent(in) :: n,m - integer,intent(out) :: istat - integer :: num - character(len=1),pointer,dimension(:) :: tmp - - istat=0 - if ( (n<0) .OR. (m<=0) ) then - istat=10 - return - endif - - if ( .not. associated(c) ) then - allocate(c(m),stat=istat) ! allocate new memory - return - endif - - tmp=>c ! save pointer to original mem - nullify(c) - allocate(c(m),stat=istat) ! allocate new memory - if ( istat /= 0 ) then - c=>tmp - return - endif - if ( n /= 0 ) then - num=min(n,m) - c(1:num)=tmp(1:num) ! copy data from orig mem to new loc. - endif - deallocate(tmp) ! deallocate original memory - return - end subroutine - - subroutine realloc_r(c,n,m,istat) - real,pointer,dimension(:) :: c - integer,intent(in) :: n,m - integer,intent(out) :: istat - integer :: num - real,pointer,dimension(:) :: tmp - - istat=0 - if ( (n<0) .OR. (m<=0) ) then - istat=10 - return - endif - - if ( .not. associated(c) ) then - allocate(c(m),stat=istat) ! allocate new memory - return - endif - - tmp=>c ! save pointer to original mem - nullify(c) - allocate(c(m),stat=istat) ! allocate new memory - if ( istat /= 0 ) then - c=>tmp - return - endif - if ( n /= 0 ) then - num=min(n,m) - c(1:num)=tmp(1:num) ! copy data from orig mem to new loc. - endif - deallocate(tmp) ! deallocate original memory - return - end subroutine - - subroutine realloc_i(c,n,m,istat) - integer,pointer,dimension(:) :: c - integer,intent(in) :: n,m - integer,intent(out) :: istat - integer :: num - integer,pointer,dimension(:) :: tmp - - istat=0 - if ( (n<0) .OR. (m<=0) ) then - istat=10 - return - endif - - if ( .not. associated(c) ) then - allocate(c(m),stat=istat) ! allocate new memory - return - endif - - tmp=>c ! save pointer to original mem - nullify(c) - allocate(c(m),stat=istat) ! allocate new memory - if ( istat /= 0 ) then - c=>tmp - return - endif - if ( n /= 0 ) then - num=min(n,m) - c(1:num)=tmp(1:num) ! copy data from orig mem to new loc. - endif - deallocate(tmp) ! deallocate original memory - return - end subroutine - - end module re_alloc diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/reduce.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/reduce.f deleted file mode 100755 index 110137e314..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/reduce.f +++ /dev/null @@ -1,343 +0,0 @@ - SUBROUTINE REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT, - 1 NOVREF,IBXX2,IER) -C -C NOVEMBER 2001 GLAHN TDL GRIB2 -C MARCH 2002 GLAHN COMMENT IER = 715 -C MARCH 2002 GLAHN MODIFIED TO ACCOMMODATE LX=1 ON ENTRY -C -C PURPOSE -C DETERMINES WHETHER THE NUMBER OF GROUPS SHOULD BE -C INCREASED IN ORDER TO REDUCE THE SIZE OF THE LARGE -C GROUPS, AND TO MAKE THAT ADJUSTMENT. BY REDUCING THE -C SIZE OF THE LARGE GROUPS, LESS BITS MAY BE NECESSARY -C FOR PACKING THE GROUP SIZES AND ALL THE INFORMATION -C ABOUT THE GROUPS. -C -C THE REFERENCE FOR NOV( ) WAS REMOVED IN THE CALLING -C ROUTINE SO THAT KBIT COULD BE DETERMINED. THIS -C FURNISHES A STARTING POINT FOR THE ITERATIONS IN REDUCE. -C HOWEVER, THE REFERENCE MUST BE CONSIDERED. -C -C DATA SET USE -C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) -C -C VARIABLES IN CALL SEQUENCE -C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) -C JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX). IT IS -C POSSIBLE AFTER SPLITTING THE GROUPS, JMIN( ) -C WILL NOT BE THE MINIMUM OF THE NEW GROUP. -C THIS DOESN'T MATTER; JMIN( ) IS REALLY THE -C GROUP REFERENCE AND DOESN'T HAVE TO BE THE -C SMALLEST VALUE. (INPUT/OUTPUT) -C JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). -C (INPUT/OUTPUT) -C LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP -C (J=1,LX). (INPUT/OUTPUT) -C NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX). -C (INPUT/OUTPUT) -C LX = THE NUMBER OF GROUPS. THIS WILL BE INCREASED -C IF GROUPS ARE SPLIT. (INPUT/OUTPUT) -C NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND -C NOV( ). (INPUT) -C IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J) -C VALUES, J=1,LX. (INPUT) -C JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J) -C VALUES, J=1,LX. (INPUT) -C KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J) -C VALUES, J=1,LX. IF THE GROUPS ARE SPLIT, KBIT -C IS REDUCED. (INPUT/OUTPUT) -C NOVREF = REFERENCE VALUE FOR NOV( ). (INPUT) -C IBXX2(J) = 2**J (J=0,30). (INPUT) -C IER = ERROR RETURN. (OUTPUT) -C 0 = GOOD RETURN. -C 714 = PROBLEM IN ALGORITHM. REDUCE ABORTED. -C 715 = NGP NOT LARGE ENOUGH. REDUCE ABORTED. -C NTOTBT(J) = THE TOTAL BITS USED FOR THE PACKING BITS J -C (J=1,30). (INTERNAL) -C NBOXJ(J) = NEW BOXES NEEDED FOR THE PACKING BITS J -C (J=1,30). (INTERNAL) -C NEWBOX(L) = NUMBER OF NEW BOXES (GROUPS) FOR EACH ORIGINAL -C GROUP (L=1,LX) FOR THE CURRENT J. (AUTOMATIC) -C (INTERNAL) -C NEWBOXP(L) = SAME AS NEWBOX( ) BUT FOR THE PREVIOUS J. -C THIS ELIMINATES RECOMPUTATION. (AUTOMATIC) -C (INTERNAL) -C CFEED = CONTAINS THE CHARACTER REPRESENTATION -C OF A PRINTER FORM FEED. (CHARACTER) (INTERNAL) -C IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER -C FORM FEED. (INTERNAL) -C IORIGB = THE ORIGINAL NUMBER OF BITS NECESSARY -C FOR THE GROUP VALUES. (INTERNAL) -C 1 2 3 4 5 6 7 X -C -C NON SYSTEM SUBROUTINES CALLED -C NONE -c - CHARACTER*1 CFEED -C - DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG) - DIMENSION NEWBOX(NDG),NEWBOXP(NDG) -C NEWBOX( ) AND NEWBOXP( ) ARE AUTOMATIC ARRAYS. - DIMENSION NTOTBT(31),NBOXJ(31) - DIMENSION IBXX2(0:30) -C - DATA IFEED/12/ -C - IER=0 - IF(LX.EQ.1)GO TO 410 -C IF THERE IS ONLY ONE GROUP, RETURN. -C - CFEED=CHAR(IFEED) -C -C INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO. -C - DO 110 L=1,LX - NEWBOX(L)=0 - 110 CONTINUE -C -C INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO. -C - DO 112 J=1,31 - NTOTBT(J)=999999999 - NBOXJ(J)=0 - 112 CONTINUE -C - IORIGB=(IBIT+JBIT+KBIT)*LX -C IBIT = BITS TO PACK THE JMIN( ). -C JBIT = BITS TO PACK THE LBIT( ). -C KBIT = BITS TO PACK THE NOV( ). -C LX = NUMBER OF GROUPS. - NTOTBT(KBIT)=IORIGB -C THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX -C GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP -C LENGHTS. SETTING THIS HERE MAKES ONE LESS LOOPS -C NECESSARY BELOW. -C -C COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED. -C -C DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING -C NOV( ) WITH VALUES GREATER THAN THRESHOLDS. ASSUME A GROUP IS -C SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT -C CHANGING IBIT OR JBIT. -C - JJ=0 -C - DO 200 J=MIN(30,KBIT-1),2,-1 -C VALUES GE KBIT WILL NOT REQUIRE SPLITS. ONCE THE TOTAL -C BITS START INCREASING WITH DECREASING J, STOP. ALSO, THE -C NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT). -C - NEWBOXT=0 -C - DO 190 L=1,LX -C - IF(NOV(L).LT.IBXX2(J))THEN - NEWBOX(L)=0 -C NO SPLITS OR NEW BOXES. - GO TO 190 - ELSE - NOVL=NOV(L) -C - M=(NOV(L)-1)/(IBXX2(J)-1)+1 -C M IS FOUND BY SOLVING THE EQUATION BELOW FOR M: -C (NOV(L)+M-1)/M LT IBXX2(J) -C M GT (NOV(L)-1)/(IBXX2(J)-1) -C SET M = (NOV(L)-1)/(IBXX2(J)-1)+1 - 130 NOVL=(NOV(L)+M-1)/M -C THE +M-1 IS NECESSARY. FOR INSTANCE, 15 WILL FIT -C INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO -C TWO BOXES 3 BITS WIDE EACH. -C - IF(NOVL.LT.IBXX2(J))THEN - GO TO 185 - ELSE - M=M+1 -C*** WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J) -C*** 135 FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10) - GO TO 130 - ENDIF -C -C THE ABOVE DO LOOP WILL NEVER COMPLETE. - ENDIF -C - 185 NEWBOX(L)=M-1 - NEWBOXT=NEWBOXT+M-1 - 190 CONTINUE -C - NBOXJ(J)=NEWBOXT - NTOTPR=NTOTBT(J+1) - NTOTBT(J)=(IBIT+JBIT)*(LX+NEWBOXT)+J*(LX+NEWBOXT) -C - IF(NTOTBT(J).GE.NTOTPR)THEN - JJ=J+1 -C THE PLUS IS USED BECAUSE J DECREASES PER ITERATION. - GO TO 250 - ELSE -C -C SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS -C IS THE J TO USE. -C - NEWBOXTP=NEWBOXT -C - DO 195 L=1,LX - NEWBOXP(L)=NEWBOX(L) - 195 CONTINUE -C -C WRITE(KFILDO,197)NEWBOXT,IBXX2(J) -C197 FORMAT(/' *****************************************' -C 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', -C 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 -C 3 /' *****************************************') -C WRITE(KFILDO,198) (NEWBOX(L),L=1,LX) -C198 FORMAT(/' '20I6/(' '20I6)) - - ENDIF -C -C205 WRITE(KFILDO,209)KBIT,IORIGB -C209 FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10) -C WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10), -C 1 (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10), -C 2 (N,N=11,20),(IBXX2(N),N=11,20), -C 3 (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20), -C 4 (N,N=21,30),(IBXX2(N),N=11,20), -C 5 (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30) -C210 FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'// -C 1 ' J = THE NUMBER OF BITS PER GROUP LENGTH'/ -C 2 ' IBXX2(J) = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/ -C 3 ' NTOTBT(J) = THE TOTAL BITS FOR THIS J'/ -C 4 ' NBOXJ(J) = THE NEW GROUPS FOR THIS J'/ -C 5 4(/10X,9I10)/4(/10I10)/4(/10I10)) -C - 200 CONTINUE -C - 250 PIMP=((IORIGB-NTOTBT(JJ))/FLOAT(IORIGB))*100. -C WRITE(KFILDO,252)PIMP,KBIT,JJ -C252 FORMAT(/' PERCENT IMPROVEMENT =',F6.1, -C 1 ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS') - IF(PIMP.GE.2.)THEN -C -C WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ) -C255 FORMAT(A1,/' *****************************************' -C 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', -C 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 -C 2 /' *****************************************') -C WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX) -C256 FORMAT(/' '20I6) -C -C ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS. -C THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED -C PER GROUP ARE NOT CHANGED. THIS MAY MEAN THAT A -C GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO. -C THIS SHOULD NOT MATTER TO THE UNPACKER. -C - LXNKP=LX+NEWBOXTP -C LXNKP = THE NEW NUMBER OF BOXES -C - IF(LXNKP.GT.NDG)THEN -C DIMENSIONS NOT LARGE ENOUGH. PROBABLY AN ERROR -C OF SOME SORT. ABORT. -C WRITE(KFILDO,257)NDG,LXNPK -C 1 2 3 4 5 6 7 X -C257 FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8, -C 1 ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF', -C 2 ' GROUPS =',I8,'. ABORT REDUCE.') - IER=715 - GO TO 410 -C AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE -C WITHOUT CALLING REDUCE. - ENDIF -C - LXN=LXNKP -C LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING -C FILLED. IT DECREASES PER ITERATION. - IBXX2M1=IBXX2(JJ)-1 -C IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP. -C - DO 300 L=LX,1,-1 -C -C THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF. -C WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE -C MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF. -C THIS HAS TO BE CONSIDERED IN MOVING VALUES. -C - IF(NEWBOXP(L)*(IBXX2M1+NOVREF)+NOVREF.GT.NOV(L)+NOVREF)THEN -C IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES -C FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR -C THE LAST BOX. NOT A TOLERABLE SITUATION. - MOVMIN=(NOV(L)-(NEWBOXP(L))*NOVREF)/NEWBOXP(L) - LEFT=NOV(L) -C LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL -C BOX TO EACH NEW BOX EXCEPT THE LAST. LEFT IS THE -C NUMBER LEFT TO MOVE. - ELSE - MOVMIN=IBXX2M1 -C MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX. - LEFT=NOV(L) -C LEFT IS THE NUMBER OF VALUES LEFT TO MOVE. - ENDIF -C - IF(NEWBOXP(L).GT.0)THEN - IF((MOVMIN+NOVREF)*NEWBOXP(L)+NOVREF.LE.NOV(L)+NOVREF. - 1 AND.(MOVMIN+NOVREF)*(NEWBOXP(L)+1).GE.NOV(L)+NOVREF)THEN - GO TO 288 - ELSE -C***D WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L) -C***D287 FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,', -C***D 1 'NEWBOXP(L),NOV(L)',5I12 -C***D 2 ' REDUCE ABORTED.') -C WRITE(KFILDO,2870) -C2870 FORMAT(/' AN ERROR IN REDUCE ALGORITHM. ABORT REDUCE.') - IER=714 - GO TO 410 -C AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE -C WITHOUT CALLING REDUCE. - ENDIF -C - ENDIF -C - 288 DO 290 J=1,NEWBOXP(L)+1 - MOVE=MIN(MOVMIN,LEFT) - JMIN(LXN)=JMIN(L) - JMAX(LXN)=JMAX(L) - LBIT(LXN)=LBIT(L) - NOV(LXN)=MOVE - LXN=LXN-1 - LEFT=LEFT-(MOVE+NOVREF) -C THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF -C MOVE + NOVREF VALUES. - 290 CONTINUE -C - IF(LEFT.NE.-NOVREF)THEN -C*** WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L), -C*** 1 MOVMIN -C*** 292 FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,', -C*** 1 'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12) - ENDIF -C - 300 CONTINUE -C - LX=LXNKP -C LX IS NOW THE NEW NUMBER OF GROUPS. - KBIT=JJ -C KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING -C GROUP LENGHTS. - ENDIF -C -C WRITE(KFILDO,406)CFEED,LX -C406 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE', -C 2 ' FOR'I10,' GROUPS', -C 3 /' *****************************************') -C WRITE(KFILDO,407) (NOV(J),J=1,LX) -C407 FORMAT(/' '20I6) -C WRITE(KFILDO,408)CFEED,LX -C408 FORMAT(A1,/' *****************************************' -C 1 /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE', -C 2 ' FOR'I10,' GROUPS', -C 3 /' *****************************************') -C WRITE(KFILDO,409) (JMIN(J),J=1,LX) -C409 FORMAT(/' '20I6) -C - 410 RETURN - END - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/simpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/simpack.f deleted file mode 100755 index bb7d5399ca..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/simpack.f +++ /dev/null @@ -1,181 +0,0 @@ - subroutine simpack(fld,ndpts,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: simpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21 -! -! ABSTRACT: This subroutine packs up a data field using a simple -! packing algorithm as defined in the GRIB2 documention. It -! also fills in GRIB2 Data Representation Template 5.0 with the -! appropriate values. -! -! PROGRAM HISTORY LOG: -! 2000-06-21 Gilbert -! -! USAGE: CALL simpack(fld,ndpts,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the data values to pack -! ndpts - The number of data values in array fld() -! idrstmpl - Contains the array of values for Data Representation -! Template 5.0 -! (1) = Reference value - ignored on input -! (2) = Binary Scale Factor -! (3) = Decimal Scale Factor -! (4) = Number of bits used to pack data, if value is -! > 0 and <= 31. -! If this input value is 0 or outside above range -! then the num of bits is calculated based on given -! data and scale factors. -! (5) = Original field type - currently ignored on input -! Data values assumed to be reals. -! -! OUTPUT ARGUMENT LIST: -! idrstmpl - Contains the array of values for Data Representation -! Template 5.0 -! (1) = Reference value - set by simpack routine. -! (2) = Binary Scale Factor - unchanged from input -! (3) = Decimal Scale Factor - unchanged from input -! (4) = Number of bits used to pack data, unchanged from -! input if value is between 0 and 31. -! If this input value is 0 or outside above range -! then the num of bits is calculated based on given -! data and scale factors. -! (5) = Original field type - currently set = 0 on output. -! Data values assumed to be reals. -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - integer,intent(in) :: ndpts - real,intent(in) :: fld(ndpts) - character(len=1),intent(out) :: cpack(*) - integer,intent(inout) :: idrstmpl(*) - integer,intent(out) :: lcpack - - real(4) :: ref - integer(4) :: iref - integer :: ifld(ndpts) - integer,parameter :: zero=0 - - bscale=2.0**real(-idrstmpl(2)) - dscale=10.0**real(idrstmpl(3)) - if (idrstmpl(4).le.0.OR.idrstmpl(4).gt.31) then - nbits=0 - else - nbits=idrstmpl(4) - endif -! -! Find max and min values in the data -! - rmax=fld(1) - rmin=fld(1) - do j=2,ndpts - if (fld(j).gt.rmax) rmax=fld(j) - if (fld(j).lt.rmin) rmin=fld(j) - enddo -! -! If max and min values are not equal, pack up field. -! If they are equal, we have a constant field, and the reference -! value (rmin) is the value for each point in the field and -! set nbits to 0. -! - if (rmin.ne.rmax) then - ! - ! Determine which algorithm to use based on user-supplied - ! binary scale factor and number of bits. - ! - if (nbits.eq.0.AND.idrstmpl(2).eq.0) then - ! - ! No binary scaling and calculate minumum number of - ! bits in which the data will fit. - ! - imin=nint(rmin*dscale) - imax=nint(rmax*dscale) - maxdif=imax-imin - temp=alog(real(maxdif+1))/alog(2.0) - nbits=ceiling(temp) - rmin=real(imin) - ! scale data - do j=1,ndpts - ifld(j)=nint(fld(j)*dscale)-imin - enddo - elseif (nbits.ne.0.AND.idrstmpl(2).eq.0) then - ! - ! Use minimum number of bits specified by user and - ! adjust binary scaling factor to accomodate data. - ! - rmin=rmin*dscale - rmax=rmax*dscale - maxnum=(2**nbits)-1 - temp=alog(real(maxnum)/(rmax-rmin))/alog(2.0) - idrstmpl(2)=ceiling(-1.0*temp) - bscale=2.0**real(-idrstmpl(2)) - ! scale data - do j=1,ndpts - ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale) - enddo - elseif (nbits.eq.0.AND.idrstmpl(2).ne.0) then - ! - ! Use binary scaling factor and calculate minumum number of - ! bits in which the data will fit. - ! - rmin=rmin*dscale - rmax=rmax*dscale - maxdif=nint((rmax-rmin)*bscale) - temp=alog(real(maxdif+1))/alog(2.0) - nbits=ceiling(temp) - ! scale data - do j=1,ndpts - ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale) - enddo - elseif (nbits.ne.0.AND.idrstmpl(2).ne.0) then - ! - ! Use binary scaling factor and use minumum number of - ! bits specified by user. Dangerous - may loose - ! information if binary scale factor and nbits not set - ! properly by user. - ! - rmin=rmin*dscale - ! scale data - do j=1,ndpts - ifld(j)=nint(((fld(j)*dscale)-rmin)*bscale) - enddo - endif - ! - ! Pack data, Pad last octet with Zeros, if necessary, - ! and calculate the length of the packed data in bytes - ! - call sbytes(cpack,ifld,0,nbits,0,ndpts) - nbittot=nbits*ndpts - left=8-mod(nbittot,8) - if (left.ne.8) then - call sbyte(cpack,zero,nbittot,left) ! Pad with zeros to fill Octet - nbittot=nbittot+left - endif - lcpack=nbittot/8 - - else - nbits=0 - lcpack=0 - endif - -! -! Fill in ref value and number of bits in Template 5.0 -! - call mkieee(rmin,ref,1) ! ensure reference value is IEEE format - !print *,'SAGref = ',rmin,ref -! call gbyte(ref,idrstmpl(1),0,32) - iref=transfer(ref,iref) - idrstmpl(1)=iref - idrstmpl(4)=nbits - idrstmpl(5)=0 ! original data were reals - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/simunpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/simunpack.f deleted file mode 100755 index 612a28355f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/simunpack.f +++ /dev/null @@ -1,65 +0,0 @@ - subroutine simunpack(cpack,len,idrstmpl,ndpts,fld) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: simunpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21 -! -! ABSTRACT: This subroutine unpacks a data field that was packed using a -! simple packing algorithm as defined in the GRIB2 documention, -! using info from the GRIB2 Data Representation Template 5.0. -! -! PROGRAM HISTORY LOG: -! 2000-06-21 Gilbert -! -! USAGE: CALL simunpack(cpack,len,idrstmpl,ndpts,fld) -! INPUT ARGUMENT LIST: -! cpack - The packed data field (character*1 array) -! len - length of packed field cpack(). -! idrstmpl - Contains the array of values for Data Representation -! Template 5.0 -! ndpts - The number of data values to unpack -! -! OUTPUT ARGUMENT LIST: -! fld() - Contains the unpacked data values -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cpack(len) - integer,intent(in) :: ndpts,len - integer,intent(in) :: idrstmpl(*) - real,intent(out) :: fld(ndpts) - - integer :: ifld(ndpts) - integer(4) :: ieee - real :: ref,bscale,dscale - - ieee = idrstmpl(1) - call rdieee(ieee,ref,1) - bscale = 2.0**real(idrstmpl(2)) - dscale = 10.0**real(-idrstmpl(3)) - nbits = idrstmpl(4) - itype = idrstmpl(5) -! -! if nbits equals 0, we have a constant field where the reference value -! is the data value at each gridpoint -! - if (nbits.ne.0) then - call gbytes(cpack,ifld,0,nbits,0,ndpts) - do j=1,ndpts - fld(j)=((real(ifld(j))*bscale)+ref)*dscale - enddo - else - do j=1,ndpts - fld(j)=ref - enddo - endif - - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/skgb.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/skgb.f deleted file mode 100755 index c81e903438..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/skgb.f +++ /dev/null @@ -1,78 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: SKGB SEARCH FOR NEXT GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 93-11-22 -C -C ABSTRACT: THIS SUBPROGRAM SEARCHES A FILE FOR THE NEXT GRIB 1 MESSAGE. -C A GRIB 1 MESSAGE IS IDENTIFIED BY ITS INDICATOR SECTION, I.E. -C AN 8-BYTE SEQUENCE WITH 'GRIB' IN BYTES 1-4 AND 1 IN BYTE 8. -C IF FOUND, THE LENGTH OF THE MESSAGE IS DECODED FROM BYTES 5-7. -C THE SEARCH IS DONE OVER A GIVEN SECTION OF THE FILE. -C THE SEARCH IS TERMINATED IF AN EOF OR I/O ERROR IS ENCOUNTERED. -C -C PROGRAM HISTORY LOG: -C 93-11-22 IREDELL -C 95-10-31 IREDELL ADD CALL TO BAREAD -C 97-03-14 IREDELL CHECK FOR '7777' -C 2001-12-05 GILBERT MODIFIED TO ALSO LOOK FOR GRIB2 MESSAGES -C -C USAGE: CALL SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB) -C INPUT ARGUMENTS: -C LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE -C ISEEK INTEGER NUMBER OF BYTES TO SKIP BEFORE SEARCH -C MSEEK INTEGER MAXIMUM NUMBER OF BYTES TO SEARCH -C OUTPUT ARGUMENTS: -C LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE MESSAGE -C LGRIB INTEGER NUMBER OF BYTES IN MESSAGE (0 IF NOT FOUND) -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C GBYTE GET INTEGER DATA FROM BYTES -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN -C -C$$$ - PARAMETER(LSEEK=128) - CHARACTER Z(LSEEK) - CHARACTER Z4(4) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - LGRIB=0 - KS=ISEEK - KN=MIN(LSEEK,MSEEK) - KZ=LSEEK -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C LOOP UNTIL GRIB MESSAGE IS FOUND - DOWHILE(LGRIB.EQ.0.AND.KN.GE.8.AND.KZ.EQ.LSEEK) -C READ PARTIAL SECTION - CALL BAREAD(LUGB,KS,KN,KZ,Z) - KM=KZ-8+1 - K=0 -C LOOK FOR 'GRIB...1' IN PARTIAL SECTION - DOWHILE(LGRIB.EQ.0.AND.K.LT.KM) - CALL GBYTE(Z,I4,(K+0)*8,4*8) - CALL GBYTE(Z,I1,(K+7)*8,1*8) - IF(I4.EQ.1196575042.AND.(I1.EQ.1.OR.I1.EQ.2)) THEN -C LOOK FOR '7777' AT END OF GRIB MESSAGE - IF (I1.EQ.1) CALL GBYTE(Z,KG,(K+4)*8,3*8) - IF (I1.EQ.2) CALL GBYTE(Z,KG,(K+12)*8,4*8) - CALL BAREAD(LUGB,KS+K+KG-4,4,K4,Z4) - IF(K4.EQ.4) THEN - CALL GBYTE(Z4,I4,0,4*8) - IF(I4.EQ.926365495) THEN -C GRIB MESSAGE FOUND - LSKIP=KS+K - LGRIB=KG - ENDIF - ENDIF - ENDIF - K=K+1 - ENDDO - KS=KS+KM - KN=MIN(LSEEK,ISEEK+MSEEK-KS) - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/specpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/specpack.f deleted file mode 100755 index eb24c71941..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/specpack.f +++ /dev/null @@ -1,124 +0,0 @@ - subroutine specpack(fld,ndpts,JJ,KK,MM,idrstmpl,cpack,lcpack) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: specpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-19 -! -! ABSTRACT: This subroutine packs a spectral data field using the complex -! packing algorithm for spherical harmonic data as -! defined in the GRIB2 Data Representation Template 5.51. -! -! PROGRAM HISTORY LOG: -! 2002-12-19 Gilbert -! -! USAGE: CALL specpack(fld,ndpts,JJ,KK,MM,idrstmpl,cpack,lcpack) -! INPUT ARGUMENT LIST: -! fld() - Contains the packed data values -! ndpts - The number of data values to pack -! JJ - J - pentagonal resolution parameter -! KK - K - pentagonal resolution parameter -! MM - M - pentagonal resolution parameter -! idrstmpl - Contains the array of values for Data Representation -! Template 5.51 -! -! OUTPUT ARGUMENT LIST: -! cpack - The packed data field (character*1 array) -! lcpack - length of packed field cpack(). -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - real,intent(in) :: fld(ndpts) - integer,intent(in) :: ndpts,JJ,KK,MM - integer,intent(inout) :: idrstmpl(*) - character(len=1),intent(out) :: cpack(*) - integer,intent(out) :: lcpack - - integer :: ifld(ndpts),Ts,tmplsim(5) - real :: bscale,dscale,unpk(ndpts),tfld(ndpts) - real,allocatable :: pscale(:) - - bscale = 2.0**real(-idrstmpl(2)) - dscale = 10.0**real(idrstmpl(3)) - nbits = idrstmpl(4) - Js=idrstmpl(6) - Ks=idrstmpl(7) - Ms=idrstmpl(8) - Ts=idrstmpl(9) - -! -! Calculate Laplacian scaling factors for each possible wave number. -! - allocate(pscale(JJ+MM)) - tscale=real(idrstmpl(5))*1E-6 - do n=Js,JJ+MM - pscale(n)=real(n*(n+1))**(tscale) - enddo -! -! Separate spectral coeffs into two lists; one to contain unpacked -! values within the sub-spectrum Js, Ks, Ms, and the other with values -! outside of the sub-spectrum to be packed. -! - inc=1 - incu=1 - incp=1 - do m=0,MM - Nm=JJ ! triangular or trapezoidal - if ( KK .eq. JJ+MM ) Nm=JJ+m ! rhombodial - Ns=Js ! triangular or trapezoidal - if ( Ks .eq. Js+Ms ) Ns=Js+m ! rhombodial - do n=m,Nm - if (n.le.Ns .AND. m.le.Ms) then ! save unpacked value - unpk(incu)=fld(inc) ! real part - unpk(incu+1)=fld(inc+1) ! imaginary part - inc=inc+2 - incu=incu+2 - else ! Save value to be packed and scale - ! Laplacian scale factor - tfld(incp)=fld(inc)*pscale(n) ! real part - tfld(incp+1)=fld(inc+1)*pscale(n) ! imaginary part - inc=inc+2 - incp=incp+2 - endif - enddo - enddo - - deallocate(pscale) - - incu=incu-1 - if (incu .ne. Ts) then - print *,'specpack: Incorrect number of unpacked values ', - & 'given:',Ts - print *,'specpack: Resetting idrstmpl(9) to ',incu - Ts=incu - endif -! -! Add unpacked values to the packed data array in 32-bit IEEE format -! - call mkieee(unpk,cpack,Ts) - ipos=4*Ts -! -! Scale and pack the rest of the coefficients -! - tmplsim(2)=idrstmpl(2) - tmplsim(3)=idrstmpl(3) - tmplsim(4)=idrstmpl(4) - call simpack(tfld,ndpts-Ts,tmplsim,cpack(ipos+1),lcpack) - lcpack=lcpack+ipos -! -! Fill in Template 5.51 -! - idrstmpl(1)=tmplsim(1) - idrstmpl(2)=tmplsim(2) - idrstmpl(3)=tmplsim(3) - idrstmpl(4)=tmplsim(4) - idrstmpl(9)=Ts - idrstmpl(10)=1 ! Unpacked spectral data is 32-bit IEEE - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/specunpack.f b/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/specunpack.f deleted file mode 100755 index 744e5ae6bd..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/g2lib-1.1.8/specunpack.f +++ /dev/null @@ -1,107 +0,0 @@ - subroutine specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: specunpack -! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-19 -! -! ABSTRACT: This subroutine unpacks a spectral data field that was packed -! using the complex packing algorithm for spherical harmonic data as -! defined in the GRIB2 documention, -! using info from the GRIB2 Data Representation Template 5.51. -! -! PROGRAM HISTORY LOG: -! 2002-12-19 Gilbert -! -! USAGE: CALL specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld) -! INPUT ARGUMENT LIST: -! cpack - The packed data field (character*1 array) -! len - length of packed field cpack(). -! idrstmpl - Contains the array of values for Data Representation -! Template 5.51 -! ndpts - The number of data values to unpack -! JJ - J - pentagonal resolution parameter -! KK - K - pentagonal resolution parameter -! MM - M - pentagonal resolution parameter -! -! OUTPUT ARGUMENT LIST: -! fld() - Contains the unpacked data values -! -! REMARKS: None -! -! ATTRIBUTES: -! LANGUAGE: XL Fortran 90 -! MACHINE: IBM SP -! -!$$$ - - character(len=1),intent(in) :: cpack(len) - integer,intent(in) :: ndpts,len,JJ,KK,MM - integer,intent(in) :: idrstmpl(*) - real,intent(out) :: fld(ndpts) - - integer :: ifld(ndpts),Ts - integer(4) :: ieee - real :: ref,bscale,dscale,unpk(ndpts) - real,allocatable :: pscale(:) - - ieee = idrstmpl(1) - call rdieee(ieee,ref,1) - bscale = 2.0**real(idrstmpl(2)) - dscale = 10.0**real(-idrstmpl(3)) - nbits = idrstmpl(4) - Js=idrstmpl(6) - Ks=idrstmpl(7) - Ms=idrstmpl(8) - Ts=idrstmpl(9) - - if (idrstmpl(10).eq.1) then ! unpacked floats are 32-bit IEEE - !call gbytes(cpack,ifld,0,32,0,Ts) - call rdieee(cpack,unpk,Ts) ! read IEEE unpacked floats - iofst=32*Ts - call gbytes(cpack,ifld,iofst,nbits,0,ndpts-Ts) ! unpack scaled data -! -! Calculate Laplacian scaling factors for each possible wave number. -! - allocate(pscale(JJ+MM)) - tscale=real(idrstmpl(5))*1E-6 - do n=Js,JJ+MM - pscale(n)=real(n*(n+1))**(-tscale) - enddo -! -! Assemble spectral coeffs back to original order. -! - inc=1 - incu=1 - incp=1 - do m=0,MM - Nm=JJ ! triangular or trapezoidal - if ( KK .eq. JJ+MM ) Nm=JJ+m ! rhombodial - Ns=Js ! triangular or trapezoidal - if ( Ks .eq. Js+Ms ) Ns=Js+m ! rhombodial - do n=m,Nm - if (n.le.Ns .AND. m.le.Ms) then ! grab unpacked value - fld(inc)=unpk(incu) ! real part - fld(inc+1)=unpk(incu+1) ! imaginary part - inc=inc+2 - incu=incu+2 - else ! Calc coeff from packed value - fld(inc)=((real(ifld(incp))*bscale)+ref)* - & dscale*pscale(n) ! real part - fld(inc+1)=((real(ifld(incp+1))*bscale)+ref)* - & dscale*pscale(n) ! imaginary part - inc=inc+2 - incp=incp+2 - endif - enddo - enddo - - deallocate(pscale) - - else - print *,'specunpack: Cannot handle 64 or 128-bit floats.' - fld=0.0 - return - endif - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/CHANGES b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/CHANGES deleted file mode 100755 index f2d8972824..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/CHANGES +++ /dev/null @@ -1,18 +0,0 @@ - -w3lib-1.1 - August 2003 - Original version - -w3lib-1.2 - July 2004 - Added new grids - -w3lib-1.3 - December 2006 - Added new grids and corrected the LAT/LON increment - -w3lib-1.4 - May 2007 - Update routines (w3fi71.f and w3fi63.f) to add - new data represent type 204 (CURVILINEAR ORTHOGONAL GRID) - and corrected the LAT/LON increment and Added new - grids - -w3lib-1.5 - NOV 2007 - Update routines (w3fi71.f and w3fi63.f) to add - new grids (10, 99, 150, 151,197) and changed grid 198 - from Arkawa Staggered E-grid to Polar Stereographic grid. - -w3lib-1.6 - JAN 2008 - Update routines (w3fi71.f and w3fi63.f) to add - new grids 195 and Changed grid 196 (from Arakawa-E to Mercator) diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/Makefile b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/Makefile deleted file mode 100755 index 303d96a697..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/Makefile +++ /dev/null @@ -1,76 +0,0 @@ -LIB = libw3.a - -# Make sure one of the following options appears in your CFLAGS -# variable to indicate which system you are on. -# -DLINUX, -DSGI, -DHP, -DCRAY90, -DIBM4, -DIBM8, -DLINUXF90 - -# OPTIONS FOR IBM-SP -#F77 = xlf -#FFLAGS = -O3 -qnosave -qarch=auto -#CFLAGS = -DIBM4 -q64 -#ARFLAGS = -X64 -#CC = cc - -# OPTIONS FOR LINUX LAHEY -#F77 = lf95 -#FFLAGS = -X9 -Ad -Am -fw -#CFLAGS = -O -DLINUX -#CC = cc - -# OPTIONS FOR LINUX G95 -F77 = gfortran -FFLAGS = -g -O2 -CFLAGS = -O2 -DLINUX -CC = gcc -ARFLAGS = ruc - -# OPTIONS FOR VPP5000 -#F77 = frt -#FFLAGS = -X9 -Ad -Sw -Am -Of -Wv,-Of -#CFLAGS = -O -K4 -DVPP5000 -#CC = vcc - -.SUFFIXES: .o .f .F .c -# -# ***************************************************************** -# -OBJ_MOD = bacio_module.o - -OBJS = \ -getgb.o getgbmh.o putgbex.o w3fi73.o baciof.o \ -getgb1r.o getgbmp.o putgbn.o w3fi74.o \ -getgb1re.o getgbp.o r63w72.o w3fi75.o \ -getgb1s.o getgi.o sbyte.o w3fi76.o \ -getgbe.o getgir.o sbytes.o w3fi82.o \ -getgbeh.o idsdef.o skgb.o w3fi83.o \ -getgbem.o iw3jdn.o w3difdat.o w3fs26.o \ -getgbemh.o ixgb.o w3doxdat.o w3log.o \ -getgbemp.o lengds.o w3fi01.o w3movdat.o \ -getgbens.o pdsens.o w3fi58.o w3reddat.o \ -getgbep.o pdseup.o w3fi59.o w3tagb.o \ -errmsg.o getgbex.o putgb.o w3fi63.o \ -getgbexm.o putgbe.o w3fi68.o \ -gbytes_char.o getgbh.o putgben.o w3fi71.o \ -getbit.o getgbm.o putgbens.o w3fi72.o \ -errexit.o fparsei.o fparser.o instrument.o start.o summary.o w3utcdat.o \ -w3fs21.o w3locdat.o - -OBJS_CC= bacio.v1.3.o mova2i.o - -SRC = $(OBJ_MOD:.o=.f) $(OBJS:.o=.f) $(OBJS_CC:.o=.c) -# -# ***************************************************************** -# - -$(LIB): $(OBJ_MOD) $(OBJS) $(OBJS_CC) - ar $(ARFLAGS) $(LIB) $(OBJ_MOD) $(OBJS) $(OBJS_CC) - -clean: - rm -f $(OBJ_MOD) $(OBJS) $(OBJS_CC) *.mod *.a - -.F.o: - $(F77) $(FFLAGS) -c -d $< -.f.o: - $(F77) $(FFLAGS) -c $< -.c.o: - $(CC) $(CFLAGS) $(DEFS) -c $< diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/README b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/README deleted file mode 100755 index 736253100e..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/README +++ /dev/null @@ -1,21 +0,0 @@ - Jul 29, 2004 - W/NP11:SAG - -W3lib Library. - -This library contains Fortran 90 decoder/encoder -routines for GRIB edition 1, general date manipulation -routines, and a Fortran 90 interface to "C" -language I/O routines. The user API for the GRIB1 routines -is described in file "grib1.doc". - -Some Fortran routines call "C" functions, which must -follow a specific symbol naming convention used by your -machine/loader to be linked successfully. -If you are having trouble linking to the routines -in this library, please make sure the appropriate -machine is defined as an option in the CFLAGS -variable in the Makefile. See the first few lines -of the Makefile for valid options. -Recompile the library. - diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio.v1.3.c b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio.v1.3.c deleted file mode 100755 index 43e5857098..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio.v1.3.c +++ /dev/null @@ -1,644 +0,0 @@ -/* Fortran-callable routines to read and write characther (bacio) and */ -/* numeric (banio) data byte addressably */ -/* Robert Grumbine 16 March 1998 */ -/* v1.1: Put diagnostic output under control of define VERBOSE or QUIET */ -/* Add option of non-seeking read/write */ -/* Return code for fewer data read/written than requested */ -/* v1.2: Add cray compatibility 20 April 1998 */ - -#include -#include -#include -#include -#include -#include -#include -#include - -/* Include the C library file for definition/control */ -/* Things that might be changed for new systems are there. */ -/* This source file should not (need to) be edited, merely recompiled */ -#include "clib.h" - - -/* Return Codes: */ -/* 0 All was well */ -/* -1 Tried to open read only _and_ write only */ -/* -2 Tried to read and write in the same call */ -/* -3 Internal failure in name processing */ -/* -4 Failure in opening file */ -/* -5 Tried to read on a write-only file */ -/* -6 Failed in read to find the 'start' location */ -/* -7 Tried to write to a read only file */ -/* -8 Failed in write to find the 'start' location */ -/* -9 Error in close */ -/* -10 Read or wrote fewer data than requested */ - -/* Note: In your Fortran code, call bacio, not bacio_. */ -/*int bacio_(int * mode, int * start, int * size, int * no, int * nactual, */ -/* int * fdes, const char *fname, char *data, int namelen, */ -/* int datanamelen) */ -/* Arguments: */ -/* Mode is the integer specifying operations to be performed */ -/* see the clib.inc file for the values. Mode is obtained */ -/* by adding together the values corresponding to the operations */ -/* The best method is to include the clib.inc file and refer to the */ -/* names for the operations rather than rely on hard-coded values */ -/* Start is the byte number to start your operation from. 0 is the first */ -/* byte in the file, not 1. */ -/* Newpos is the position in the file after a read or write has been */ -/* performed. You'll need this if you're doing 'seeking' read/write */ -/* Size is the size of the objects you are trying to read. Rely on the */ -/* values in the locale.inc file. Types are CHARACTER, INTEGER, REAL, */ -/* COMPLEX. Specify the correct value by using SIZEOF_type, where type */ -/* is one of these. (After having included the locale.inc file) */ -/* no is the number of things to read or write (characters, integers, */ -/* whatever) */ -/* nactual is the number of things actually read or written. Check that */ -/* you got what you wanted. */ -/* fdes is an integer 'file descriptor'. This is not a Fortran Unit Number */ -/* You can use it, however, to refer to files you've previously opened. */ -/* fname is the name of the file. This only needs to be defined when you */ -/* are opening a file. It must be (on the Fortran side) declared as */ -/* CHARACTER*N, where N is a length greater than or equal to the length */ -/* of the file name. CHARACTER*1 fname[80] (for example) will fail. */ -/* data is the name of the entity (variable, vector, array) that you want */ -/* to write data out from or read it in to. The fact that C is declaring */ -/* it to be a char * does not affect your fortran. */ -/* namelen - Do NOT specify this. It is created automagically by the */ -/* Fortran compiler */ -/* datanamelen - Ditto */ - - -/* What is going on here is that although the Fortran caller will always */ -/* be calling bacio, the called C routine name will change from system */ -/* to system. */ -#ifdef CRAY90 - #include - int BACIO - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, - _fcd fcd_fname, _fcd fcd_datary) { - char *fname, *datary; - int namelen; -#endif -#ifdef HP - int bacio - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen, int datanamelen) { -#endif -#ifdef SGI - int bacio_ - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen, int datanamelen) { -#endif -#ifdef LINUX - int bacio_ - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen, int datanamelen) { -#endif -#ifdef LINUXF90 - int BACIO - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen, int datanamelen) { -#endif -#ifdef VPP5000 - int bacio_ - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen, int datanamelen) { -#endif -#ifdef IBM4 - int bacio - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen, int datanamelen) { -#endif -#ifdef IBM8 - long long int bacio - (long long int * mode, long long int * start, long long int *newpos, - long long int * size, long long int * no, - long long int * nactual, long long int * fdes, const char *fname, - char *datary, - long long int namelen, long long int datanamelen) { -#endif - int i, j, jret, seekret; - char *realname, *tempchar; - int tcharval; - size_t count; - -/* Initialization(s) */ - *nactual = 0; - -/* Check for illegal combinations of options */ - if (( BAOPEN_RONLY & *mode) && - ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) { - #ifdef VERBOSE - printf("illegal -- trying to open both read only and write only\n"); - #endif - return -1; - } - if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) { - #ifdef VERBOSE - printf("illegal -- trying to both read and write in the same call\n"); - #endif - return -2; - } - -/* This section handles Fortran to C translation of strings so as to */ -/* be able to open the files Fortran is expecting to be opened. */ - #ifdef CRAY90 - namelen = _fcdlen(fcd_fname); - fname = _fcdtocp(fcd_fname); - #endif - if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || - (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) || - (BAOPEN_RW & *mode) ) { - #ifdef VERBOSE - printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout); - printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout); - #endif - realname = (char *) malloc( namelen * sizeof(char) ) ; - if (realname == NULL) { - #ifdef VERBOSE - printf("failed to mallocate realname %d = namelen\n", namelen); - fflush(stdout); - #endif - return -3; - } - tempchar = (char *) malloc(sizeof(char) * 1 ) ; - i = 0; - j = 0; - *tempchar = fname[i]; - tcharval = *tempchar; - while (i == j && i < namelen ) { - fflush(stdout); - if ( isgraph(tcharval) ) { - realname[j] = fname[i]; - j += 1; - } - i += 1; - *tempchar = fname[i]; - tcharval = *tempchar; - } - free(tempchar); - #ifdef VERBOSE - printf("i,j = %d %d\n",i,j); fflush(stdout); - #endif - realname[j] = '\0'; - } - -/* Open files with correct read/write and file permission. */ - if (BAOPEN_RONLY & *mode) { - #ifdef VERBOSE - printf("open read only %s\n", realname); - #endif - *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_WONLY & *mode ) { - #ifdef VERBOSE - printf("open write only %s\n", realname); - #endif - *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_WONLY_TRUNC & *mode ) { - #ifdef VERBOSE - printf("open write only with truncation %s\n", realname); - #endif - *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_WONLY_APPEND & *mode ) { - #ifdef VERBOSE - printf("open write only with append %s\n", realname); - #endif - *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_RW & *mode) { - #ifdef VERBOSE - printf("open read-write %s\n", realname); - #endif - *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else { - #ifdef VERBOSE - printf("no openings\n"); - #endif - } - if (*fdes < 0) { - #ifdef VERBOSE - printf("error in file descriptor! *fdes %d\n", *fdes); - #endif - return -4; - } - else { - #ifdef VERBOSE - printf("file descriptor = %d\n",*fdes ); - #endif - } - - -/* Read data as requested */ - if (BAREAD & *mode && - ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) { - #ifdef VERBOSE - printf("Error, trying to read while in write only mode!\n"); - #endif - return -5; - } - else if (BAREAD & *mode ) { - /* Read in some data */ - if (! (*mode & NOSEEK) ) { - seekret = lseek(*fdes, *start, SEEK_SET); - if (seekret == -1) { - #ifdef VERBOSE - printf("error in seeking to %d\n",*start); - #endif - return -6; - } - #ifdef VERBOSE - else { - printf("Seek successful, seek ret %d, start %d\n", seekret, *start); - } - #endif - } - #ifdef CRAY90 - datary = _fcdtocp(fcd_datary); - #endif - if (datary == NULL) { - printf("Reading Massive catastrophe -- datary pointer is NULL\n"); - return -666; - } - #ifdef VERBOSE - printf("file descriptor, datary = %d %d\n", *fdes, (int) datary); - #endif - count = (size_t) *no; - jret = read(*fdes, (void *) datary, count); - if (jret != *no) { - #ifdef VERBOSE - printf("did not read in the requested number of bytes\n"); - printf("read in %d bytes instead of %d \n",jret, *no); - #endif - } - else { - #ifdef VERBOSE - printf("read in %d bytes requested \n", *no); - #endif - } - *nactual = jret; - *newpos = *start + jret; - } -/* Done with reading */ - -/* See if we should be writing */ - if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) { - #ifdef VERBOSE - printf("Trying to write on a read only file \n"); - #endif - return -7; - } - else if ( BAWRITE & *mode ) { - if (! (*mode & NOSEEK) ) { - seekret = lseek(*fdes, *start, SEEK_SET); - if (seekret == -1) { - #ifdef VERBOSE - printf("error in seeking to %d\n",*start); - #endif - return -8; - } - } - #ifdef CRAY90 - datary = _fcdtocp(fcd_datary); - #endif - if (datary == NULL) { - printf("Writing Massive catastrophe -- datary pointer is NULL\n"); - return -666; - } - #ifdef VERBOSE - printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary); - #endif - count = (size_t) *no; - jret = write(*fdes, (void *) datary, count); - if (jret != *no) { - #ifdef VERBOSE - printf("did not write out the requested number of bytes\n"); - printf("wrote %d bytes instead\n", jret); - #endif - *nactual = jret; - *newpos = *start + jret; - } - else { - #ifdef VERBOSE - printf("wrote %d bytes \n", jret); - #endif - *nactual = jret; - *newpos = *start + jret; - } - } -/* Done with writing */ - -/* Close file if requested */ - if (BACLOSE & *mode ) { - jret = close(*fdes); - if (jret != 0) { - #ifdef VERBOSE - printf("close failed! jret = %d\n",jret); - #endif - return -9; - } - } - if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || - (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) || - (BAOPEN_RW & *mode) ) { - free(realname); - } -/* Done closing */ -/* Check that if we were reading or writing, that we actually got what */ -/* we expected, else return a -10. Return 0 (success) if we're here */ -/* and weren't reading or writing */ - if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) { - return -10; - } - else { - return 0; - } -} -#ifdef CRAY90 - #include - int BANIO - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, _fcd fcd_fname, void *datary) { - char *fname; - int namelen; -#endif -#ifdef HP - int banio - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen ) { -#endif -#ifdef SGI - int banio_ - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen ) { -#endif -#ifdef LINUX - int banio_ - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen ) { -#endif -#ifdef LINUXF90 - int BANIO - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen ) { -#endif -#ifdef VPP5000 - int banio_ - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen ) { -#endif -#ifdef IBM4 - int banio - (int * mode, int * start, int *newpos, int * size, int * no, - int * nactual, int * fdes, const char *fname, char *datary, - int namelen ) { -#endif -#ifdef IBM8 - long long int banio - (long long int * mode, long long int * start, long long int *newpos, - long long int * size, long long int * no, - long long int * nactual, long long int * fdes, const char *fname, - char *datary, - long long int namelen ) { -#endif - int i, j, jret, seekret; - char *realname, *tempchar; - int tcharval; - -/* Initialization(s) */ - *nactual = 0; - -/* Check for illegal combinations of options */ - if (( BAOPEN_RONLY & *mode) && - ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) { - #ifdef VERBOSE - printf("illegal -- trying to open both read only and write only\n"); - #endif - return -1; - } - if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) { - #ifdef VERBOSE - printf("illegal -- trying to both read and write in the same call\n"); - #endif - return -2; - } - -/* This section handles Fortran to C translation of strings so as to */ -/* be able to open the files Fortran is expecting to be opened. */ - #ifdef CRAY90 - namelen = _fcdlen(fcd_fname); - fname = _fcdtocp(fcd_fname); - #endif - if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || - (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) || - (BAOPEN_RW & *mode) ) { - #ifdef VERBOSE - printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout); - printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout); - #endif - realname = (char *) malloc( namelen * sizeof(char) ) ; - if (realname == NULL) { - #ifdef VERBOSE - printf("failed to mallocate realname %d = namelen\n", namelen); - fflush(stdout); - #endif - return -3; - } - tempchar = (char *) malloc(sizeof(char) * 1 ) ; - i = 0; - j = 0; - *tempchar = fname[i]; - tcharval = *tempchar; - while (i == j && i < namelen ) { - fflush(stdout); - if ( isgraph(tcharval) ) { - realname[j] = fname[i]; - j += 1; - } - i += 1; - *tempchar = fname[i]; - tcharval = *tempchar; - } - free(tempchar); - #ifdef VERBOSE - printf("i,j = %d %d\n",i,j); fflush(stdout); - #endif - realname[j] = '\0'; - } - -/* Open files with correct read/write and file permission. */ - if (BAOPEN_RONLY & *mode) { - #ifdef VERBOSE - printf("open read only %s\n", realname); - #endif - *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_WONLY & *mode ) { - #ifdef VERBOSE - printf("open write only %s\n", realname); - #endif - *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_WONLY_TRUNC & *mode ) { - #ifdef VERBOSE - printf("open write only with truncation %s\n", realname); - #endif - *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_WONLY_APPEND & *mode ) { - #ifdef VERBOSE - printf("open write only with append %s\n", realname); - #endif - *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else if (BAOPEN_RW & *mode) { - #ifdef VERBOSE - printf("open read-write %s\n", realname); - #endif - *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO ); - } - else { - #ifdef VERBOSE - printf("no openings\n"); - #endif - } - if (*fdes < 0) { - #ifdef VERBOSE - printf("error in file descriptor! *fdes %d\n", *fdes); - #endif - return -4; - } - else { - #ifdef VERBOSE - printf("file descriptor = %d\n",*fdes ); - #endif - } - - -/* Read data as requested */ - if (BAREAD & *mode && - ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) { - #ifdef VERBOSE - printf("Error, trying to read while in write only mode!\n"); - #endif - return -5; - } - else if (BAREAD & *mode ) { - /* Read in some data */ - if (! (*mode & NOSEEK) ) { - seekret = lseek(*fdes, *start, SEEK_SET); - if (seekret == -1) { - #ifdef VERBOSE - printf("error in seeking to %d\n",*start); - #endif - return -6; - } - #ifdef VERBOSE - else { - printf("Seek successful, seek ret %d, start %d\n", seekret, *start); - } - #endif - } - jret = read(*fdes, datary, *no*(*size) ); - if (jret != *no*(*size) ) { - #ifdef VERBOSE - printf("did not read in the requested number of items\n"); - printf("read in %d items of %d \n",jret/(*size), *no); - #endif - *nactual = jret/(*size); - *newpos = *start + jret; - } - #ifdef VERBOSE - printf("read in %d items \n", jret/(*size)); - #endif - *nactual = jret/(*size); - *newpos = *start + jret; - } -/* Done with reading */ - -/* See if we should be writing */ - if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) { - #ifdef VERBOSE - printf("Trying to write on a read only file \n"); - #endif - return -7; - } - else if ( BAWRITE & *mode ) { - if (! (*mode & NOSEEK) ) { - seekret = lseek(*fdes, *start, SEEK_SET); - if (seekret == -1) { - #ifdef VERBOSE - printf("error in seeking to %d\n",*start); - #endif - return -8; - } - #ifdef VERBOSE - else { - printf("Seek successful, seek ret %d, start %d\n", seekret, *start); - } - #endif - } - jret = write(*fdes, datary, *no*(*size)); - if (jret != *no*(*size)) { - #ifdef VERBOSE - printf("did not write out the requested number of items\n"); - printf("wrote %d items instead\n", jret/(*size) ); - #endif - *nactual = jret/(*size) ; - *newpos = *start + jret; - } - else { - #ifdef VERBOSE - printf("wrote %d items \n", jret/(*size) ); - #endif - *nactual = jret/(*size) ; - *newpos = *start + jret; - } - } -/* Done with writing */ - - -/* Close file if requested */ - if (BACLOSE & *mode ) { - jret = close(*fdes); - if (jret != 0) { - #ifdef VERBOSE - printf("close failed! jret = %d\n",jret); - #endif - return -9; - } - } - if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || - (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) || - (BAOPEN_RW & *mode) ) { - free(realname); - } -/* Done closing */ - //free(realname); -/* Check that if we were reading or writing, that we actually got what */ -/* we expected, else return a -10. Return 0 (success) if we're here */ -/* and weren't reading or writing */ - if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) { - return -10; - } - else { - return 0; - } -} diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio_module.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio_module.f deleted file mode 100755 index 13de9db39f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio_module.f +++ /dev/null @@ -1,23 +0,0 @@ -C----------------------------------------------------------------------- - MODULE BACIO_MODULE -C$$$ F90-MODULE DOCUMENTATION BLOCK -C -C F90-MODULE: BACIO_MODULE BYTE-ADDRESSABLE I/O MODULE -C PRGMMR: IREDELL ORG: NP23 DATE: 98-06-04 -C -C ABSTRACT: MODULE TO SHARE FILE DESCRIPTORS -C IN THE BYTE-ADDESSABLE I/O PACKAGE. -C -C PROGRAM HISTORY LOG: -C 98-06-04 IREDELL -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - INTEGER,EXTERNAL:: BACIO - INTEGER,DIMENSION(999),SAVE:: FD=999*0 - INTEGER,DIMENSION(20),SAVE:: BAOPTS=0 - INCLUDE 'baciof.h' - END - diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio_module.mod b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio_module.mod deleted file mode 100644 index 8de57b2498..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/bacio_module.mod +++ /dev/null @@ -1,55 +0,0 @@ -GFORTRAN module created from baciof.f on Mon Nov 16 16:43:04 2009 -If you edit this, you'll get what you deserve. - -(() () () () () () () () () () () () () () () () () () () () ()) - -() - -() - -() - -() - -(2 'bacio_close' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '8') -() 0 () ()) -3 'bacio_module' 'bacio_module' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (UNKNOWN 0 ()) 0 0 () () 0 () ()) -4 'bacio' 'bacio_module' 1 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN EXTERNAL) (INTEGER 4 ()) 0 0 () () 0 () ()) -5 'bacio_openrw' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '4') -() 0 () ()) -6 'bacio_openr' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '1') () 0 () ()) -7 'bacio_read' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '16') () 0 () -()) -8 'bacio_openwt' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 -'128') () 0 () ()) -9 'bacio_openwa' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 -'256') () 0 () ()) -10 'bacio_openw' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 '2') -() 0 () ()) -11 'fd' 'bacio_module' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN -DIMENSION SAVE) (INTEGER 4 ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 ()) -0 '1') (CONSTANT (INTEGER 4 ()) 0 '999')) 0 () ()) -12 'baopts' 'bacio_module' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC -UNKNOWN DIMENSION SAVE) (INTEGER 4 ()) 0 0 () (1 EXPLICIT (CONSTANT ( -INTEGER 4 ()) 0 '1') (CONSTANT (INTEGER 4 ()) 0 '20')) 0 () ()) -13 'bacio_write' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 -'32') () 0 () ()) -14 'bacio_noseek' 'bacio_module' 1 ((PARAMETER UNKNOWN-INTENT -UNKNOWN-PROC UNKNOWN) (INTEGER 4 ()) 0 0 () (CONSTANT (INTEGER 4 ()) 0 -'64') () 0 () ()) -) - -('bacio_noseek' 0 14 'bacio' 0 4 'bacio_module' 0 3 'bacio_close' 0 2 -'bacio_write' 0 13 'bacio_openw' 0 10 'bacio_openr' 0 6 'bacio_openrw' 0 -5 'bacio_openwa' 0 9 'bacio_openwt' 0 8 'bacio_read' 0 7 'baopts' 0 12 -'fd' 0 11) diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/baciof.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/baciof.f deleted file mode 100755 index cf8ef26fde..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/baciof.f +++ /dev/null @@ -1,524 +0,0 @@ -C----------------------------------------------------------------------- - MODULE BACIO_MODULE -C$$$ F90-MODULE DOCUMENTATION BLOCK -C -C F90-MODULE: BACIO_MODULE BYTE-ADDRESSABLE I/O MODULE -C PRGMMR: IREDELL ORG: NP23 DATE: 98-06-04 -C -C ABSTRACT: MODULE TO SHARE FILE DESCRIPTORS -C IN THE BYTE-ADDESSABLE I/O PACKAGE. -C -C PROGRAM HISTORY LOG: -C 98-06-04 IREDELL -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - INTEGER,EXTERNAL:: BACIO - INTEGER,DIMENSION(999),SAVE:: FD=999*0 - INTEGER,DIMENSION(20),SAVE:: BAOPTS=0 - INCLUDE 'baciof.h' - END -C----------------------------------------------------------------------- - SUBROUTINE BASETO(NOPT,VOPT) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BASETO BYTE-ADDRESSABLE SET OPTIONS -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: SET OPTIONS FOR BYTE-ADDRESSABLE I/O. -C ALL OPTIONS DEFAULT TO 0. -C OPTION 1: BLOCKED READING OPTION -C IF THE OPTION VALUE IS 1, THEN THE READING IS BLOCKED -C INTO FOUR 4096-BYTE BUFFERS. THIS MAY BE EFFICIENT IF -C THE READS WILL BE REQUESTED IN MUCH SMALLER CHUNKS. -C OTHERWISE, EACH CALL TO BAREAD INITIATES A PHYSICAL READ. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BASETO(NOPT,VOPT) -C INPUT ARGUMENTS: -C NOPT INTEGER OPTION NUMBER -C VOPT INTEGER OPTION VALUE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - INTEGER NOPT,VOPT -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(NOPT.GE.1.AND.NOPT.LE.20) BAOPTS(NOPT)=VOPT -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAOPEN(LU,CFN,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAOPEN BYTE-ADDRESSABLE OPEN -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAOPEN(LU,CFN,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO OPEN -C CFN CHARACTER FILENAME TO OPEN -C (CONSISTING OF NONBLANK PRINTABLE CHARACTERS) -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER CFN*(*) - CHARACTER(80) CMSG -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(LU.LT.001.OR.LU.GT.999) THEN - IRET=6 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_OPENRW,IB,JB,1,NB,KA,FD(LU),CFN//CHAR(0),A) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAOPENR(LU,CFN,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAOPENR BYTE-ADDRESSABLE OPEN -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR READ ONLY. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAOPENR(LU,CFN,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO OPEN -C CFN CHARACTER FILENAME TO OPEN -C (CONSISTING OF NONBLANK PRINTABLE CHARACTERS) -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER CFN*(*) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(LU.LT.001.OR.LU.GT.999) THEN - IRET=6 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_OPENR,IB,JB,1,NB,KA,FD(LU),CFN//CHAR(0),A) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAOPENW(LU,CFN,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAOPENW BYTE-ADDRESSABLE OPEN -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAOPENW(LU,CFN,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO OPEN -C CFN CHARACTER FILENAME TO OPEN -C (CONSISTING OF NONBLANK PRINTABLE CHARACTERS) -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER CFN*(*) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(LU.LT.001.OR.LU.GT.999) THEN - IRET=6 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_OPENW,IB,JB,1,NB,KA,FD(LU),CFN//CHAR(0),A) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAOPENWT(LU,CFN,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAOPENWT BYTE-ADDRESSABLE OPEN -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY WITH TRUNCATION. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAOPENWT(LU,CFN,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO OPEN -C CFN CHARACTER FILENAME TO OPEN -C (CONSISTING OF NONBLANK PRINTABLE CHARACTERS) -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER CFN*(*) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(LU.LT.001.OR.LU.GT.999) THEN - IRET=6 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_OPENWT,IB,JB,1,NB,KA,FD(LU),CFN//CHAR(0),A) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAOPENWA(LU,CFN,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAOPENWA BYTE-ADDRESSABLE OPEN -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY WITH APPEND. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAOPENWA(LU,CFN,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO OPEN -C CFN CHARACTER FILENAME TO OPEN -C (CONSISTING OF NONBLANK PRINTABLE CHARACTERS) -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER CFN*(*) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(LU.LT.001.OR.LU.GT.999) THEN - IRET=6 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_OPENWA,IB,JB,1,NB,KA,FD(LU),CFN//CHAR(0),A) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BACLOSE(LU,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BACLOSE BYTE-ADDRESSABLE CLOSE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: CLOSE A BYTE-ADDRESSABLE FILE. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BACLOSE(LU,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO CLOSE -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C REMARKS: A BAOPEN MUST HAVE ALREADY BEEN CALLED. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(LU.LT.001.OR.LU.GT.999) THEN - IRET=6 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_CLOSE,IB,JB,1,NB,KA,FD(LU),CFN,A) - IF(IRET.EQ.0) FD(LU)=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAREAD(LU,IB,NB,KA,A) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAREAD BYTE-ADDRESSABLE READ -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: READ A GIVEN NUMBER OF BYTES FROM AN UNBLOCKED FILE, -C SKIPPING A GIVEN NUMBER OF BYTES. -C THE PHYSICAL I/O IS BLOCKED INTO FOUR 4096-BYTE BUFFERS -C IF THE BYTE-ADDRESSABLE OPTION 1 HAS BEEN SET TO 1 BY BASETO. -C THIS BUFFERED READING IS INCOMPATIBLE WITH NO-SEEK READING. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAREAD(LU,IB,NB,KA,A) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO READ -C IB INTEGER NUMBER OF BYTES TO SKIP -C (IF IB<0, THEN THE FILE IS ACCESSED WITH NO SEEKING) -C NB INTEGER NUMBER OF BYTES TO READ -C OUTPUT ARGUMENTS: -C KA INTEGER NUMBER OF BYTES ACTUALLY READ -C A CHARACTER*1 (NB) DATA READ -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C REMARKS: A BAOPEN MUST HAVE ALREADY BEEN CALLED. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER A(NB) - CHARACTER CFN - PARAMETER(NY=4096,MY=4) - INTEGER NS(MY),NN(MY) - CHARACTER Y(NY,MY) - DATA LUX/0/ - SAVE JY,NS,NN,Y,LUX -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(FD(LU).LE.0) THEN - KA=0 - RETURN - ENDIF - IF(IB.LT.0.AND.BAOPTS(1).EQ.1) THEN - KA=0 - RETURN - ENDIF - IF(NB.LE.0) THEN - KA=0 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C UNBUFFERED I/O - IF(BAOPTS(1).NE.1) THEN - IF(IB.GE.0) THEN - IRET=BACIO(BACIO_READ,IB,JB,1,NB,KA,FD(LU),CFN,A) - ELSE - IRET=BACIO(BACIO_READ+BACIO_NOSEEK,0,JB,1,NB,KA,FD(LU),CFN,A) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C BUFFERED I/O -C GET DATA FROM PREVIOUS CALL IF POSSIBLE - ELSE - KA=0 - IF(LUX.NE.LU) THEN - JY=0 - NS=0 - NN=0 - ELSE - DO I=1,MY - IY=MOD(JY+I-1,MY)+1 - KY=IB+KA-NS(IY) - IF(KA.LT.NB.AND.KY.GE.0.AND.KY.LT.NN(IY)) THEN - K=MIN(NB-KA,NN(IY)-KY) - A(KA+1:KA+K)=Y(KY+1:KY+K,IY) - KA=KA+K - ENDIF - ENDDO - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SET POSITION AND READ BUFFER AND GET DATA - IF(KA.LT.NB) THEN - LUX=ABS(LU) - JY=MOD(JY,MY)+1 - NS(JY)=IB+KA - IRET=BACIO(BACIO_READ,NS(JY),JB,1,NY,NN(JY), - & FD(LUX),CFN,Y(1,JY)) - IF(NN(JY).GT.0) THEN - K=MIN(NB-KA,NN(JY)) - A(KA+1:KA+K)=Y(1:K,JY) - KA=KA+K - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CONTINUE TO READ BUFFER AND GET DATA - DOWHILE(NN(JY).EQ.NY.AND.KA.LT.NB) - JY=MOD(JY,MY)+1 - NS(JY)=NS(JY)+NN(JY) - IRET=BACIO(BACIO_READ+BACIO_NOSEEK,NS(JY),JB,1,NY,NN(JY), - & FD(LUX),CFN,Y(1,JY)) - IF(NN(JY).GT.0) THEN - K=MIN(NB-KA,NN(JY)) - A(KA+1:KA+K)=Y(1:K,JY) - KA=KA+K - ENDIF - ENDDO - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE BAWRITE(LU,IB,NB,KA,A) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAWRITE BYTE-ADDRESSABLE WRITE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: WRITE A GIVEN NUMBER OF BYTES TO AN UNBLOCKED FILE, -C SKIPPING A GIVEN NUMBER OF BYTES. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAWRITE(LU,IB,NB,KA,A) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO WRITE -C IB INTEGER NUMBER OF BYTES TO SKIP -C (IF IB<0, THEN THE FILE IS ACCESSED WITH NO SEEKING) -C NB INTEGER NUMBER OF BYTES TO WRITE -C A CHARACTER*1 (NB) DATA TO WRITE -C OUTPUT ARGUMENTS: -C KA INTEGER NUMBER OF BYTES ACTUALLY WRITTEN -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C REMARKS: A BAOPEN MUST HAVE ALREADY BEEN CALLED. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER A(NB) - CHARACTER CFN -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(FD(LU).LE.0) THEN - KA=0 - RETURN - ENDIF - IF(NB.LE.0) THEN - KA=0 - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(IB.GE.0) THEN - IRET=BACIO(BACIO_WRITE,IB,JB,1,NB,KA,FD(LU),CFN,A) - ELSE - IRET=BACIO(BACIO_WRITE+BACIO_NOSEEK,0,JB,1,NB,KA,FD(LU),CFN,A) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END -C----------------------------------------------------------------------- - SUBROUTINE WRYTE(LU,NB,A) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: WRYTE WRITE DATA OUT BY BYTES -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: WRITE A GIVEN NUMBER OF BYTES TO AN UNBLOCKED FILE. -C -C PROGRAM HISTORY LOG: -C 92-10-31 IREDELL -C 95-10-31 IREDELL WORKSTATION VERSION -C 1998-06-04 IREDELL BACIO VERSION -C -C USAGE: CALL WRYTE(LU,NB,A) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO WHICH TO WRITE -C NB INTEGER NUMBER OF BYTES TO WRITE -C A CHARACTER*1 (NB) DATA TO WRITE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C REMARKS: A BAOPEN MUST HAVE ALREADY BEEN CALLED. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - USE BACIO_MODULE - CHARACTER A(NB) - CHARACTER CFN -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(FD(LU).LE.0) THEN - RETURN - ENDIF - IF(NB.LE.0) THEN - RETURN - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET=BACIO(BACIO_WRITE+BACIO_NOSEEK,0,JB,1,NB,KA,FD(LU),CFN,A) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/baciof.h b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/baciof.h deleted file mode 100755 index 4153e27dc6..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/baciof.h +++ /dev/null @@ -1,11 +0,0 @@ -! Include file to define variables for Fortran to C interface(s) -! Robert Grumbine 16 March 1998 - INTEGER,PARAMETER:: BACIO_OPENR=1 ! Open file for read only - INTEGER,PARAMETER:: BACIO_OPENW=2 ! Open file for write only - INTEGER,PARAMETER:: BACIO_OPENRW=4 ! Open file for read or write - INTEGER,PARAMETER:: BACIO_CLOSE=8 ! Close file - INTEGER,PARAMETER:: BACIO_READ=16 ! Read from the file - INTEGER,PARAMETER:: BACIO_WRITE=32 ! Write to the file - INTEGER,PARAMETER:: BACIO_NOSEEK=64 ! Start I/O from previous spot - INTEGER,PARAMETER:: BACIO_OPENWT=128 ! Open for write only with truncation - INTEGER,PARAMETER:: BACIO_OPENWA=256 ! Open for write only with append diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/clib.h b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/clib.h deleted file mode 100755 index 4a43e21088..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/clib.h +++ /dev/null @@ -1,27 +0,0 @@ -/* Include file to define variables for Fortran to C interface(s) */ -/* Robert Grumbine 16 March 1998 */ -/* NOSEEK added 25 March 1998 */ -/* CRAY compatibility added 20 April 1998 */ - -/* The following line should be either undef or define VERBOSE */ -/* The latter gives noisy debugging output, while the former */ -/* relies solely on the return codes */ -#undef VERBOSE - -/* Declare the system type, supported options are: */ -/* LINUX, SGI, HP, CRAY90, IBM4, IBM8, LINUXF90 */ -/* #define IBM4 */ -#include - -/* Do not change things below here yourself */ - -/* IO-related (bacio.c, banio.c) */ -#define BAOPEN_RONLY 1 -#define BAOPEN_WONLY 2 -#define BAOPEN_RW 4 -#define BACLOSE 8 -#define BAREAD 16 -#define BAWRITE 32 -#define NOSEEK 64 -#define BAOPEN_WONLY_TRUNC 128 -#define BAOPEN_WONLY_APPEND 256 diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errexit.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errexit.f deleted file mode 100755 index bc482fcbb5..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errexit.f +++ /dev/null @@ -1,33 +0,0 @@ - SUBROUTINE ERREXIT(IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: ERREXIT EXIT WITH A RETURN CODE -C PRGMMR: IREDELL ORG: NP23 DATE:1998-06-04 -C -C ABSTRACT: EXIT WITH A RETURN CODE -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C 1999-01-26 Gilbert - changed to use XLF utility routine exit_(n) -C instead of exit(n). exit_(n) will return -C the proper value ( n must be 4 byte int ) -C to the sh/ksh shell status variable $? -C ( $status for csh ) on the IBM SP. -C -C USAGE: CALL ERREXIT(IRET) -C INPUT ARGUMENT LIST: -C IRET - INTEGER RETURN CODE -C -C SUBPROGRAMS CALLED: -C EXIT_ - EXITS FROM A FORTRAN PROGRAM -C -C ATTRIBUTES: -C LANGUAGE: XLF FORTRAN 90 -C MACHINE: IBM SP -C -C$$$ - INTEGER IRET - INTEGER(4) JRET - JRET=IRET - CALL exit(JRET) - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errexit.f.org b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errexit.f.org deleted file mode 100755 index caff7d5d0a..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errexit.f.org +++ /dev/null @@ -1,33 +0,0 @@ - SUBROUTINE ERREXIT(IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: ERREXIT EXIT WITH A RETURN CODE -C PRGMMR: IREDELL ORG: NP23 DATE:1998-06-04 -C -C ABSTRACT: EXIT WITH A RETURN CODE -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C 1999-01-26 Gilbert - changed to use XLF utility routine exit_(n) -C instead of exit(n). exit_(n) will return -C the proper value ( n must be 4 byte int ) -C to the sh/ksh shell status variable $? -C ( $status for csh ) on the IBM SP. -C -C USAGE: CALL ERREXIT(IRET) -C INPUT ARGUMENT LIST: -C IRET - INTEGER RETURN CODE -C -C SUBPROGRAMS CALLED: -C EXIT_ - EXITS FROM A FORTRAN PROGRAM -C -C ATTRIBUTES: -C LANGUAGE: XLF FORTRAN 90 -C MACHINE: IBM SP -C -C$$$ - INTEGER IRET - INTEGER(4) JRET - JRET=IRET - CALL exit_(JRET) - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errmsg.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errmsg.f deleted file mode 100755 index c15a541ef4..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/errmsg.f +++ /dev/null @@ -1,29 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE ERRMSG(CMSG) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: ERRMSG WRITE A MESSAGE TO STDERR -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: WRITE A MESSAGE TO STDERR. -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C -C USAGE: CALL ERRMSG(CMSG) -C INPUT ARGUMENTS: -C CMSG CHARACTER*(*) MESSAGE TO WRITE -C -C REMARKS: THIS IS A MACHINE-DEPENDENT SUBPROGRAM. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN -C MACHINE: CRAY -C -C$$$ - CHARACTER*(*) CMSG -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - WRITE(0,'(A)') CMSG -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/fparsei.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/fparsei.f deleted file mode 100755 index dccf3aa157..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/fparsei.f +++ /dev/null @@ -1,39 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE FPARSEI(CARG,MARG,KARG) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FPARSER PARSE INTEGERS FROM A CHARACTER STRING -C PRGMMR: IREDELL ORG: NP23 DATE:1998-09-03 -C -C ABSTRACT: THIS SUBPROGRAM EXTRACTS INTEGERS FROM A FREE-FORMAT -C CHARACTER STRING. IT IS USEFUL FOR PARSING COMMAND ARGUMENTS. -C -C PROGRAM HISTORY LOG: -C 1998-09-03 IREDELL -C -C USAGE: CALL FPARSEI(CARG,MARG,KARG) -C -C INPUT ARGUMENT LIST: -C CARG - CHARACTER*(*) STRING OF ASCII DIGITS TO PARSE. -C INTEGERS MAY BE SEPARATED BY A COMMA OR BY BLANKS. -C MARG - INTEGER MAXIMUM NUMBER OF INTEGERS TO PARSE. -C -C OUTPUT ARGUMENT LIST: -C KARG - INTEGER (MARG) NUMBERS PARSED. -C (FROM 0 TO MARG VALUES MAY BE RETURNED.) -C -C REMARKS: -C TO DETERMINE THE ACTUAL NUMBER OF INTEGERS FOUND IN THE STRING, -C KARG SHOULD BE SET TO FILL VALUES BEFORE THE CALL TO FPARSEI AND -C THE NUMBER OF NON-FILL VALUES SHOULD BE COUNTED AFTER THE CALL. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - CHARACTER*(*) CARG - INTEGER KARG(MARG) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - READ(CARG,*,IOSTAT=IOS) KARG -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/fparser.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/fparser.f deleted file mode 100755 index 85370ccfd7..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/fparser.f +++ /dev/null @@ -1,39 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE FPARSER(CARG,MARG,RARG) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FPARSER PARSE REAL NUMBERS FROM A CHARACTER STRING -C PRGMMR: IREDELL ORG: NP23 DATE:1998-09-03 -C -C ABSTRACT: THIS SUBPROGRAM EXTRACTS REAL NUMBERS FROM A FREE-FORMAT -C CHARACTER STRING. IT IS USEFUL FOR PARSING COMMAND ARGUMENTS. -C -C PROGRAM HISTORY LOG: -C 1998-09-03 IREDELL -C -C USAGE: CALL FPARSER(CARG,MARG,RARG) -C -C INPUT ARGUMENT LIST: -C CARG - CHARACTER*(*) STRING OF ASCII DIGITS TO PARSE. -C REAL NUMBERS MAY BE SEPARATED BY A COMMA OR BY BLANKS. -C MARG - INTEGER MAXIMUM NUMBER OF REAL NUMBERS TO PARSE. -C -C OUTPUT ARGUMENT LIST: -C RARG - REAL (MARG) NUMBERS PARSED. -C (FROM 0 TO MARG VALUES MAY BE RETURNED.) -C -C REMARKS: -C TO DETERMINE THE ACTUAL NUMBER OF REAL NUMBERS FOUND IN THE STRING, -C RARG SHOULD BE SET TO FILL VALUES BEFORE THE CALL TO FPARSER AND -C THE NUMBER OF NON-FILL VALUES SHOULD BE COUNTED AFTER THE CALL. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - CHARACTER*(*) CARG - REAL RARG(MARG) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - READ(CARG,*,IOSTAT=IOS) RARG -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/gbytes_char.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/gbytes_char.f deleted file mode 100755 index 067d78269d..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/gbytes_char.f +++ /dev/null @@ -1,127 +0,0 @@ - SUBROUTINE GBYTEC(IN,IOUT,ISKIP,NBYTE) - character*1 in(*) - integer iout(*) - CALL GBYTESC(IN,IOUT,ISKIP,NBYTE,0,1) - RETURN - END - - SUBROUTINE SBYTEC(OUT,IN,ISKIP,NBYTE) - character*1 out(*) - integer in(*) - CALL SBYTESC(OUT,IN,ISKIP,NBYTE,0,1) - RETURN - END - - SUBROUTINE GBYTESC(IN,IOUT,ISKIP,NBYTE,NSKIP,N) -C Get bytes - unpack bits: Extract arbitrary size values from a -C packed bit string, right justifying each value in the unpacked -C array. -C IN = character*1 array input -C IOUT = unpacked array output -C ISKIP = initial number of bits to skip -C NBYTE = number of bits to take -C NSKIP = additional number of bits to skip on each iteration -C N = number of iterations -C v1.1 -C - character*1 in(*) - integer iout(*) - integer ones(8), tbit, bitcnt - save ones - data ones/1,3,7,15,31,63,127,255/ - -c nbit is the start position of the field in bits - nbit = iskip - do i = 1, n - bitcnt = nbyte - index=nbit/8+1 - ibit=mod(nbit,8) - nbit = nbit + nbyte + nskip - -c first byte - tbit = min(bitcnt,8-ibit) - itmp = iand(mova2i(in(index)),ones(8-ibit)) - if (tbit.ne.8-ibit) itmp = ishft(itmp,tbit-8+ibit) - index = index + 1 - bitcnt = bitcnt - tbit - -c now transfer whole bytes - do while (bitcnt.ge.8) - itmp = ior(ishft(itmp,8),mova2i(in(index))) - bitcnt = bitcnt - 8 - index = index + 1 - enddo - -c get data from last byte - if (bitcnt.gt.0) then - itmp = ior(ishft(itmp,bitcnt),iand(ishft(mova2i(in(index)), - 1 -(8-bitcnt)),ones(bitcnt))) - endif - - iout(i) = itmp - enddo - - RETURN - END - - SUBROUTINE SBYTESC(OUT,IN,ISKIP,NBYTE,NSKIP,N) -C Store bytes - pack bits: Put arbitrary size values into a -C packed bit string, taking the low order bits from each value -C in the unpacked array. -C IOUT = packed array output -C IN = unpacked array input -C ISKIP = initial number of bits to skip -C NBYTE = number of bits to pack -C NSKIP = additional number of bits to skip on each iteration -C N = number of iterations -C v1.1 -C - character*1 out(*) - integer in(N), bitcnt, ones(8), tbit - save ones - data ones/ 1, 3, 7, 15, 31, 63,127,255/ - -c number bits from zero to ... -c nbit is the last bit of the field to be filled - - nbit = iskip + nbyte - 1 - do i = 1, n - itmp = in(i) - bitcnt = nbyte - index=nbit/8+1 - ibit=mod(nbit,8) - nbit = nbit + nbyte + nskip - -c make byte aligned - if (ibit.ne.7) then - tbit = min(bitcnt,ibit+1) - imask = ishft(ones(tbit),7-ibit) - itmp2 = iand(ishft(itmp,7-ibit),imask) - itmp3 = iand(mova2i(out(index)), 255-imask) - out(index) = char(ior(itmp2,itmp3)) - bitcnt = bitcnt - tbit - itmp = ishft(itmp, -tbit) - index = index - 1 - endif - -c now byte aligned - -c do by bytes - do while (bitcnt.ge.8) - out(index) = char(iand(itmp,255)) - itmp = ishft(itmp,-8) - bitcnt = bitcnt - 8 - index = index - 1 - enddo - -c do last byte - - if (bitcnt.gt.0) then - itmp2 = iand(itmp,ones(bitcnt)) - itmp3 = iand(mova2i(out(index)), 255-ones(bitcnt)) - out(index) = char(ior(itmp2,itmp3)) - endif - enddo - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getbit.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getbit.f deleted file mode 100755 index 3e4aea6fc9..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getbit.f +++ /dev/null @@ -1,87 +0,0 @@ - SUBROUTINE GETBIT(IBM,IBS,IDS,LEN,MG,G,GROUND,GMIN,GMAX,NBIT) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETBIT COMPUTE NUMBER OF BITS AND ROUND FIELD. -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 92-10-31 -C -C ABSTRACT: THE NUMBER OF BITS REQUIRED TO PACK A GIVEN FIELD -C FOR PARTICULAR BINARY AND DECIMAL SCALINGS IS COMPUTED. -C THE FIELD IS ROUNDED OFF TO THE DECIMAL SCALING FOR PACKING. -C THE MINIMUM AND MAXIMUM ROUNDED FIELD VALUES ARE ALSO RETURNED. -C GRIB BITMAP MASKING FOR VALID DATA IS OPTIONALLY USED. -C -C PROGRAM HISTORY LOG: -C 96-09-16 IREDELL -C -C USAGE: CALL GTBITS(IBM,IBS,IDS,LEN,MG,G,GMIN,GMAX,NBIT) -C INPUT ARGUMENT LIST: -C IBM - INTEGER BITMAP FLAG (=0 FOR NO BITMAP) -C IBS - INTEGER BINARY SCALING -C (E.G. IBS=3 TO ROUND FIELD TO NEAREST EIGHTH VALUE) -C IDS - INTEGER DECIMAL SCALING -C (E.G. IDS=3 TO ROUND FIELD TO NEAREST MILLI-VALUE) -C (NOTE THAT IDS AND IBS CAN BOTH BE NONZERO, -C E.G. IDS=1 AND IBS=1 ROUNDS TO THE NEAREST TWENTIETH) -C LEN - INTEGER LENGTH OF THE FIELD AND BITMAP -C MG - INTEGER (LEN) BITMAP IF IBM=1 (0 TO SKIP, 1 TO KEEP) -C G - REAL (LEN) FIELD -C -C OUTPUT ARGUMENT LIST: -C GROUND - REAL (LEN) FIELD ROUNDED TO DECIMAL AND BINARY SCALING -C (SET TO ZERO WHERE BITMAP IS 0 IF IBM=1) -C GMIN - REAL MINIMUM VALID ROUNDED FIELD VALUE -C GMAX - REAL MAXIMUM VALID ROUNDED FIELD VALUE -C NBIT - INTEGER NUMBER OF BITS TO PACK -C -C ATTRIBUTES: -C LANGUAGE: CRAY FORTRAN -C -C$$$ - DIMENSION MG(LEN),G(LEN),GROUND(LEN) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C ROUND FIELD AND DETERMINE EXTREMES WHERE BITMAP IS ON - S=2.**IBS*10.**IDS - IF(IBM.EQ.0) THEN - GROUND(1)=NINT(G(1)*S)/S - GMAX=GROUND(1) - GMIN=GROUND(1) - DO I=2,LEN - GROUND(I)=NINT(G(I)*S)/S - GMAX=MAX(GMAX,GROUND(I)) - GMIN=MIN(GMIN,GROUND(I)) - ENDDO - ELSE - I1=1 - DOWHILE(I1.LE.LEN.AND.MG(I1).EQ.0) - I1=I1+1 - ENDDO - IF(I1.LE.LEN) THEN - DO I=1,I1-1 - GROUND(I)=0. - ENDDO - GROUND(I1)=NINT(G(I1)*S)/S - GMAX=GROUND(I1) - GMIN=GROUND(I1) - DO I=I1+1,LEN - IF(MG(I).NE.0) THEN - GROUND(I)=NINT(G(I)*S)/S - GMAX=MAX(GMAX,GROUND(I)) - GMIN=MIN(GMIN,GROUND(I)) - ELSE - GROUND(I)=0. - ENDIF - ENDDO - ELSE - DO I=1,LEN - GROUND(I)=0. - ENDDO - GMAX=0. - GMIN=0. - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COMPUTE NUMBER OF BITS - NBIT=LOG((GMAX-GMIN)*S+0.9)/LOG(2.)+1. -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb.f deleted file mode 100755 index fac9c3dfb1..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb.f +++ /dev/null @@ -1,213 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB(LUGB,LUGI,JF,J,JPDS,JGDS, - & KF,K,KPDS,KGDS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGB(LUGB,LUGI,JF,J,JPDS,JGDS, -C & KF,K,KPDS,KGDS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGBM FIND AND UNPACK GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBM AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),KPDS(200),KGDS(200) - LOGICAL*1 LB(JF) - REAL F(JF) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBM(LUGB,LUGI,JF,JJ,JPDS,JGDS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KF,K,KPDS,KGDS,LB,F,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1r.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1r.f deleted file mode 100755 index dd66fdd9e3..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1r.f +++ /dev/null @@ -1,72 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB1R(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB1R READS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: READ AND UNPACK A GRIB MESSAGE. -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C -C USAGE: CALL GETGB1R(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LSKIP INTEGER NUMBER OF BYTES TO SKIP -C LGRIB INTEGER NUMBER OF BYTES TO READ -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 97 ERROR READING GRIB FILE -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C W3FI63 UNPACK GRIB -C PDSEUP UNPACK PDS EXTENSION -C -C REMARKS: THERE IS NO PROTECTION AGAINST UNPACKING TOO MUCH DATA. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB ROUTINES ONLY. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - LOGICAL*1 LB(*) - REAL F(*) - INTEGER KPTR(200) - CHARACTER GRIB(LGRIB)*1 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ GRIB RECORD - CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C UNPACK GRIB RECORD - IF(LREAD.EQ.LGRIB) THEN - CALL W3FI63(GRIB,KPDS,KGDS,LB,F,KPTR,IRET) - IF(IRET.EQ.0.AND.KPDS(23).EQ.2) THEN - CALL PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,45,GRIB(9)) - ENDIF - ELSE - IRET=97 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C RETURN NUMBER OF POINTS - IF(IRET.EQ.0) THEN - KF=KPTR(10) - ELSE - KF=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1re.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1re.f deleted file mode 100755 index 46ad99e179..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1re.f +++ /dev/null @@ -1,81 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB1RE(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS, - & KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB1RE READS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: READ AND UNPACK A GRIB MESSAGE. -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 97-02-11 Y.ZHU INCLUDED PROBABILITY AND CLUSTER ARGUMENTS -C -C USAGE: CALL GETGB1RE(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS, -C & KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LSKIP INTEGER NUMBER OF BYTES TO SKIP -C LGRIB INTEGER NUMBER OF BYTES TO READ -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C KPROB INTEGER (2) PROBABILITY ENSEMBLE PARMS -C XPROB REAL (2) PROBABILITY ENSEMBLE PARMS -C KCLUST INTEGER (16) CLUSTER ENSEMBLE PARMS -C KMEMBR INTEGER (8) CLUSTER ENSEMBLE PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 97 ERROR READING GRIB FILE -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C W3FI63 UNPACK GRIB -C PDSEUP UNPACK PDS EXTENSION -C -C REMARKS: THERE IS NO PROTECTION AGAINST UNPACKING TOO MUCH DATA. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB ROUTINES ONLY. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - INTEGER KPROB(2),KCLUST(16),KMEMBR(80) - REAL XPROB(2) - LOGICAL*1 LB(*) - REAL F(*) - INTEGER KPTR(200) - CHARACTER GRIB(LGRIB)*1 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ GRIB RECORD - CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C UNPACK GRIB RECORD - IF(LREAD.EQ.LGRIB) THEN - CALL W3FI63(GRIB,KPDS,KGDS,LB,F,KPTR,IRET) - IF(IRET.EQ.0.AND.KPDS(23).EQ.2) THEN - CALL PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,86,GRIB(9)) - ENDIF - ELSE - IRET=97 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C RETURN NUMBER OF POINTS - IF(IRET.EQ.0) THEN - KF=KPTR(10) - ELSE - KF=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1s.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1s.f deleted file mode 100755 index ec54d7e4c0..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgb1s.f +++ /dev/null @@ -1,185 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGB1S(CBUF,NLEN,NNUM,J,JPDS,JGDS,JENS, - & K,KPDS,KGDS,KENS,LSKIP,LGRIB,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB1S FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C FIND IN THE INDEX FILE A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 2001-06-05 IREDELL APPLY LINUX PORT BY EBISUZAKI -C -C USAGE: CALL GETGB1S(CBUF,NLEN,NNUM,J,JPDS,JGDS,JENS, -C & K,KPDS,KGDS,KENS,LSKIP,LGRIB,IRET) -C INPUT ARGUMENTS: -C CBUF CHARACTER*1 (NLEN*NNUM) BUFFER CONTAINING INDEX DATA -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C OUTPUT ARGUMENTS: -C K INTEGER MESSAGE NUMBER FOUND -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C LSKIP INTEGER NUMBER OF BYTES TO SKIP -C LGRIB INTEGER NUMBER OF BYTES TO READ -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 1 REQUEST NOT FOUND -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB ROUTINES ONLY. -C -C SUBPROGRAMS CALLED: -C GBYTEC UNPACK BYTES -C FI632 UNPACK PDS -C FI633 UNPACK GDS -C PDSEUP UNPACK PDS EXTENSION -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - CHARACTER CBUF(NLEN*NNUM) - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - PARAMETER(LPDS=23,LGDS=22,LENS=5) ! ACTUAL SEARCH RANGES - CHARACTER CPDS(400)*1,CGDS(400)*1 - INTEGER KPTR(200) - INTEGER IPDSP(LPDS),JPDSP(LPDS) - INTEGER IGDSP(LGDS),JGDSP(LGDS) - INTEGER IENSP(LENS),JENSP(LENS) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COMPRESS REQUEST LISTS - K=J - LSKIP=0 - LGRIB=0 - IRET=1 -C COMPRESS PDS REQUEST - LPDSP=0 - DO I=1,LPDS - IF(JPDS(I).NE.-1) THEN - LPDSP=LPDSP+1 - IPDSP(LPDSP)=I - JPDSP(LPDSP)=JPDS(I) - ENDIF - ENDDO -C COMPRESS GDS REQUEST - LGDSP=0 - IF(JPDS(3).EQ.255) THEN - DO I=1,LGDS - IF(JGDS(I).NE.-1) THEN - LGDSP=LGDSP+1 - IGDSP(LGDSP)=I - JGDSP(LGDSP)=JGDS(I) - ENDIF - ENDDO - ENDIF -C COMPRESS ENS REQUEST - LENSP=0 - IF(JPDS(23).EQ.2) THEN - DO I=1,LENS - IF(JENS(I).NE.-1) THEN - LENSP=LENSP+1 - IENSP(LENSP)=I - JENSP(LENSP)=JENS(I) - ENDIF - ENDDO - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH FOR REQUEST - DOWHILE(IRET.NE.0.AND.K.LT.NNUM) - K=K+1 - LT=0 -C SEARCH FOR PDS REQUEST - IF(LPDSP.GT.0) THEN - CPDS=CHAR(0) - CPDS(1:28)=CBUF((K-1)*NLEN+26:(K-1)*NLEN+53) - NLESS=MAX(184-NLEN,0) - CPDS(29:40-NLESS)=CBUF((K-1)*NLEN+173:(K-1)*NLEN+184-NLESS) - KPTR=0 - CALL GBYTEC(CBUF,KPTR(3),(K-1)*NLEN*8+25*8,3*8) - KPDS(18)=1 - CALL GBYTEC(CPDS,KPDS(4),7*8,8) - CALL FI632(CPDS,KPTR,KPDS,KRET) - DO I=1,LPDSP - IP=IPDSP(I) - LT=LT+ABS(JPDS(IP)-KPDS(IP)) - ENDDO - ENDIF -C SEARCH FOR GDS REQUEST - IF(LT.EQ.0.AND.LGDSP.GT.0) THEN - CGDS=CHAR(0) - CGDS(1:42)=CBUF((K-1)*NLEN+54:(K-1)*NLEN+95) - NLESS=MAX(320-NLEN,0) - CGDS(43:178-NLESS)=CBUF((K-1)*NLEN+185:(K-1)*NLEN+320-NLESS) - KPTR=0 - CALL FI633(CGDS,KPTR,KGDS,KRET) - DO I=1,LGDSP - IP=IGDSP(I) - LT=LT+ABS(JGDS(IP)-KGDS(IP)) - ENDDO - ENDIF -C SEARCH FOR ENS REQUEST - IF(LT.EQ.0.AND.LENSP.GT.0) THEN - NLESS=MAX(172-NLEN,0) - CPDS(41:100-NLESS)=CBUF((K-1)*NLEN+113:(K-1)*NLEN+172-NLESS) - CALL PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,45,CPDS) - DO I=1,LENSP - IP=IENSP(I) - LT=LT+ABS(JENS(IP)-KENS(IP)) - ENDDO - ENDIF -C RETURN IF REQUEST IS FOUND - IF(LT.EQ.0) THEN - CALL GBYTEC(CBUF,LSKIP,(K-1)*NLEN*8,4*8) - CALL GBYTEC(CBUF,LGRIB,(K-1)*NLEN*8+20*8,4*8) - IF(LPDSP.EQ.0) THEN - CPDS=CHAR(0) - CPDS(1:28)=CBUF((K-1)*NLEN+26:(K-1)*NLEN+53) - NLESS=MAX(184-NLEN,0) - CPDS(29:40-NLESS)=CBUF((K-1)*NLEN+173:(K-1)*NLEN+184-NLESS) - KPTR=0 - CALL GBYTEC(CBUF,KPTR(3),(K-1)*NLEN*8+25*8,3*8) - KPDS(18)=1 - CALL GBYTEC(CPDS,KPDS(4),7*8,8) - CALL FI632(CPDS,KPTR,KPDS,KRET) - ENDIF - IF(LGDSP.EQ.0) THEN - CGDS=CHAR(0) - CGDS(1:42)=CBUF((K-1)*NLEN+54:(K-1)*NLEN+95) - NLESS=MAX(320-NLEN,0) - CGDS(43:178-NLESS)=CBUF((K-1)*NLEN+185:(K-1)*NLEN+320-NLESS) - KPTR=0 - CALL FI633(CGDS,KPTR,KGDS,KRET) - ENDIF - IF(KPDS(23).EQ.2.AND.LENSP.EQ.0) THEN - NLESS=MAX(172-NLEN,0) - CPDS(41:100-NLESS)=CBUF((K-1)*NLEN+113:(K-1)*NLEN+172-NLESS) - CALL PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,45,CPDS) - ENDIF - IRET=0 - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbe.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbe.f deleted file mode 100755 index 156952254b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbe.f +++ /dev/null @@ -1,223 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBE(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, - & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBE FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBE(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, -C & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGBEM FIND AND UNPACK GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBEM AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - LOGICAL*1 LB(JF) - REAL F(JF) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBEM(LUGB,LUGI,JF,JJ,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KF,K,KPDS,KGDS,KENS,LB,F,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbeh.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbeh.f deleted file mode 100755 index 030bed06fc..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbeh.f +++ /dev/null @@ -1,215 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEH(LUGB,LUGI,J,JPDS,JGDS,JENS, - & KG,KF,K,KPDS,KGDS,KENS,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEH FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN ITS MESSAGE NUMBER IS -C RETURNED ALONG WITH THE UNPACKED PDS AND GDS PARAMETERS. IF THE -C GRIB MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBEH(LUGB,LUGI,J,JPDS,JGDS,JENS, -C & KG,KF,K,KPDS,KGDS,KENS,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C (ONLY USED IF LUGI=0) -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C OUTPUT ARGUMENTS: -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C KF INTEGER NUMBER OF DATA POINTS IN THE MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGBEMH FIND GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBEMH AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBEMH(LUGB,LUGI,JJ,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,KF,K,KPDS,KGDS,KENS,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbem.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbem.f deleted file mode 100755 index e214846cbc..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbem.f +++ /dev/null @@ -1,274 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEM(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEM FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBEM(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C GETGB1R READ AND UNPACK GRIB RECORD -C LENGDS RETURN THE LENGTH OF A GRID -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - CHARACTER CBUF(MBUF) - LOGICAL*1 LB(JF) - REAL F(JF) - PARAMETER(MSK1=32000,MSK2=4000) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSEIF(LENGDS(KGDS).GT.JF) THEN - IRET=98 - ELSE - CALL GETGB1R(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,LB,F,IRET) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbemh.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbemh.f deleted file mode 100755 index deb36ab806..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbemh.f +++ /dev/null @@ -1,265 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEMH(LUGB,LUGI,J,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,KF,K,KPDS,KGDS,KENS,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEMH FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN ITS MESSAGE NUMBER IS -C RETURNED ALONG WITH THE UNPACKED PDS AND GDS PARAMETERS. IF THE -C GRIB MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBEMH(LUGB,LUGI,J,JPDS,JGDS,JENS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KG,KF,K,KPDS,KGDS,KENS,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C (ONLY USED IF LUGI=0) -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C KF INTEGER NUMBER OF DATA POINTS IN THE MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C LENGDS RETURN THE LENGTH OF A GRID -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - CHARACTER CBUF(MBUF) - PARAMETER(MSK1=32000,MSK2=4000) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSE - KG=LGRIB - KF=LENGDS(KGDS) - IRET=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbemp.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbemp.f deleted file mode 100755 index b21b83ce3d..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbemp.f +++ /dev/null @@ -1,271 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEMP(LUGB,LUGI,JG,J,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,K,KPDS,KGDS,KENS,G,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEMP FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE. ITS MESSAGE NUMBER IS RETURNED ALONG WITH THE UNPACKED -C PDS AND GDS PARAMETERS AND THE PACKED GRIB MESSAGE. IF THE GRIB -C MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBEMP(LUGB,LUGI,JG,J,JPDS,JGDS,JENS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KG,K,KPDS,KGDS,KENS,G,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JG INTEGER MAXIMUM NUMBER OF BYTES IN THE GRIB MESSAGE -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C G CHARACTER*1 (KG) GRIB MESSAGE -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF BYTES GREATER THAN JG -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C BAREAD READ GRIB RECORD -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - CHARACTER CBUF(MBUF) - CHARACTER G(JG) - PARAMETER(MSK1=32000,MSK2=4000) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSEIF(LGRIB.GT.JG) THEN - IRET=98 - ELSE - IRET=97 - CALL BAREAD(LUGB,LSKIP,LGRIB,KG,G) - IF(KG.EQ.LGRIB) IRET=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbens.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbens.f deleted file mode 100755 index 039680ee81..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbens.f +++ /dev/null @@ -1,207 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBENS(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, - & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBENS FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C THIS OBSOLESCENT VERSION HAS BEEN REPLACED BY GETGBE. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBENS(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, -C & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGBE FIND AND UNPACK GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBEM AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - LOGICAL*1 LB(JF) - REAL F(JF) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PRINT *,'PLEASE USE GETGBE RATHER THAN GETGBENS' - CALL GETGBE(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, - & KF,K,KPDS,KGDS,KENS,LB,F,IRET) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbep.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbep.f deleted file mode 100755 index 19faea0711..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbep.f +++ /dev/null @@ -1,219 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEP(LUGB,LUGI,JG,J,JPDS,JGDS,JENS, - & KG,K,KPDS,KGDS,KENS,G,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEP FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE. ITS MESSAGE NUMBER IS RETURNED ALONG WITH THE UNPACKED -C PDS AND GDS PARAMETERS AND THE PACKED GRIB MESSAGE. IF THE GRIB -C MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBEP(LUGB,LUGI,JG,J,JPDS,JGDS,JENS, -C & KG,K,KPDS,KGDS,KENS,G,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JG INTEGER MAXIMUM NUMBER OF BYTES IN THE GRIB MESSAGE -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C OUTPUT ARGUMENTS: -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C G CHARACTER*1 (KG) GRIB MESSAGE -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF BYTES GREATER THAN JG -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGBEMP FIND GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBEMP AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - CHARACTER G(JG) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBEMP(LUGB,LUGI,JG,JJ,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,K,KPDS,KGDS,KENS,G,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbex.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbex.f deleted file mode 100755 index 4698b0fa48..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbex.f +++ /dev/null @@ -1,233 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEX(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, - & KF,K,KPDS,KGDS,KENS,KPROB,XPROB,KCLUST,KMEMBR, - & LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEX FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C 97-02-11 Y.ZHU INCLUDED PROBABILITY AND CLUSTER ARGUMENTS -C -C USAGE: CALL GETGBEX(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, -C & KF,K,KPDS,KGDS,KENS,KPROB,XPROB,KCLUST,KMEMBR, -C & LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C KPROB INTEGER (2) PROBABILITY ENSEMBLE PARMS -C XPROB REAL (2) PROBABILITY ENSEMBLE PARMS -C KCLUST INTEGER (16) CLUSTER ENSEMBLE PARMS -C KMEMBR INTEGER (8) CLUSTER ENSEMBLE PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGBEXM FIND AND UNPACK GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBEXM AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - INTEGER KPROB(2),KCLUST(16),KMEMBR(80) - REAL XPROB(2) - LOGICAL*1 LB(JF) - REAL F(JF) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBEXM(LUGB,LUGI,JF,JJ,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KF,K,KPDS,KGDS,KENS,KPROB,XPROB,KCLUST,KMEMBR, - & LB,F,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbexm.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbexm.f deleted file mode 100755 index 765c6d5a0d..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbexm.f +++ /dev/null @@ -1,284 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBEXM(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KF,K,KPDS,KGDS,KENS,KPROB,XPROB,KCLUST,KMEMBR, - & LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBEXM FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C 97-02-11 Y.ZHU INCLUDED PROBABILITY AND CLUSTER ARGUMENTS -C -C USAGE: CALL GETGBEXM(LUGB,LUGI,JF,J,JPDS,JGDS,JENS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KF,K,KPDS,KGDS,KENS,KPROB,XPROB,KCLUST,KMEMBR, -C & LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C JENS INTEGER (200) ENSEMBLE PDS PARMS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(23)=2) -C (=-1 FOR WILDCARD) -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C KENS INTEGER (200) UNPACKED ENSEMBLE PDS PARMS -C KPROB INTEGER (2) PROBABILITY ENSEMBLE PARMS -C XPROB REAL (2) PROBABILITY ENSEMBLE PARMS -C KCLUST INTEGER (16) CLUSTER ENSEMBLE PARMS -C KMEMBR INTEGER (8) CLUSTER ENSEMBLE PARMS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C GETGB1RE READ AND UNPACK GRIB RECORD -C LENGDS RETURN THE LENGTH OF A GRID -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),JENS(200) - INTEGER KPDS(200),KGDS(200),KENS(200) - INTEGER KPROB(2),KCLUST(16),KMEMBR(80) - REAL XPROB(2) - CHARACTER CBUF(MBUF) - LOGICAL*1 LB(JF) - REAL F(JF) - PARAMETER(MSK1=32000,MSK2=4000) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSEIF(LENGDS(KGDS).GT.JF) THEN - IRET=98 - ELSE - CALL GETGB1RE(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS, - & KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbh.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbh.f deleted file mode 100755 index 115dee4ac7..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbh.f +++ /dev/null @@ -1,206 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBH(LUGB,LUGI,J,JPDS,JGDS, - & KG,KF,K,KPDS,KGDS,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBH FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN ITS MESSAGE NUMBER IS -C RETURNED ALONG WITH THE UNPACKED PDS AND GDS PARAMETERS. IF THE -C GRIB MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBH(LUGB,LUGI,J,JPDS,JGDS, -C & KG,KF,K,KPDS,KGDS,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C (ONLY USED IF LUGI=0) -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C OUTPUT ARGUMENTS: -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C KF INTEGER NUMBER OF DATA POINTS IN THE MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGBMH FIND GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBMH AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200) - INTEGER KPDS(200),KGDS(200) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBMH(LUGB,LUGI,JJ,JPDS,JGDS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,KF,K,KPDS,KGDS,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbm.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbm.f deleted file mode 100755 index 3290769757..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbm.f +++ /dev/null @@ -1,267 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBM(LUGB,LUGI,JF,J,JPDS,JGDS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KF,K,KPDS,KGDS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBM FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBM(LUGB,LUGI,JF,J,JPDS,JGDS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KF,K,KPDS,KGDS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C GETGB1R READ AND UNPACK GRIB RECORD -C LENGDS RETURN THE LENGTH OF A GRID -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200) - INTEGER KPDS(200),KGDS(200) - CHARACTER CBUF(MBUF) - LOGICAL*1 LB(JF) - REAL F(JF) - PARAMETER(MSK1=32000,MSK2=4000) - INTEGER JENS(200),KENS(200) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - JENS=-1 - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND UNPACK GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSEIF(LENGDS(KGDS).GT.JF) THEN - IRET=98 - ELSE - CALL GETGB1R(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,LB,F,IRET) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbmh.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbmh.f deleted file mode 100755 index 6d7f78e865..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbmh.f +++ /dev/null @@ -1,258 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBMH(LUGB,LUGI,J,JPDS,JGDS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,KF,K,KPDS,KGDS,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBMH FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN ITS MESSAGE NUMBER IS -C RETURNED ALONG WITH THE UNPACKED PDS AND GDS PARAMETERS. IF THE -C GRIB MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBMH(LUGB,LUGI,J,JPDS,JGDS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KG,KF,K,KPDS,KGDS,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C (ONLY USED IF LUGI=0) -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C KF INTEGER NUMBER OF DATA POINTS IN THE MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C LENGDS RETURN THE LENGTH OF A GRID -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200) - INTEGER KPDS(200),KGDS(200) - CHARACTER CBUF(MBUF) - PARAMETER(MSK1=32000,MSK2=4000) - INTEGER JENS(200),KENS(200) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - JENS=-1 - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSE - KG=LGRIB - KF=LENGDS(KGDS) - IRET=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbmp.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbmp.f deleted file mode 100755 index ca6e1ef1e3..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbmp.f +++ /dev/null @@ -1,264 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBMP(LUGB,LUGI,JG,J,JPDS,JGDS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,K,KPDS,KGDS,G,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBMP FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE. ITS MESSAGE NUMBER IS RETURNED ALONG WITH THE UNPACKED -C PDS AND GDS PARAMETERS AND THE PACKED GRIB MESSAGE. IF THE GRIB -C MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBMP(LUGB,LUGI,JG,J,JPDS,JGDS, -C & MBUF,CBUF,NLEN,NNUM,MNUM, -C & KG,K,KPDS,KGDS,G,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JG INTEGER MAXIMUM NUMBER OF BYTES IN THE GRIB MESSAGE -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C MBUF INTEGER LENGTH OF INDEX BUFFER IN BYTES -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C (INITIALIZE BY SETTING J=-1) -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C (INITIALIZE BY SETTING J=-1) -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (INITIALIZE BY SETTING J=-1) -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C (INITIALIZE BY SETTING J=-1) -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) INDEX BUFFER -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C MNUM INTEGER NUMBER OF INDEX RECORDS SKIPPED -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C G CHARACTER*1 (KG) GRIB MESSAGE -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF BYTES GREATER THAN JG -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGI READ INDEX FILE -C GETGIR READ INDEX BUFFER FROM GRIB FILE -C GETGB1S SEARCH INDEX RECORDS -C BAREAD READ GRIB RECORD -C -C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200) - INTEGER KPDS(200),KGDS(200) - CHARACTER CBUF(MBUF) - CHARACTER G(JG) - PARAMETER(MSK1=32000,MSK2=4000) - INTEGER JENS(200),KENS(200) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH PREVIOUS INDEX BUFFER IF POSSIBLE - JENS=-1 - IF(J.GE.0) THEN - IF(MNUM.GE.0) THEN - IRGI=0 - ELSE - MNUM=-1-MNUM - IRGI=1 - ENDIF - JR=J-MNUM - IF(JR.GE.0.AND.(JR.LT.NNUM.OR.IRGI.EQ.0)) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ELSE - MNUM=J - IRGI=1 - IRGS=1 - ENDIF - ELSE - MNUM=-1-J - IRGI=1 - IRGS=1 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ AND SEARCH NEXT INDEX BUFFER - JR=0 - DOWHILE(IRGI.EQ.1.AND.IRGS.EQ.1) - IF(LUGI.GT.0) THEN - CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ELSE - CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI) - ENDIF - IF(IRGI.LE.1) THEN - CALL GETGB1S(CBUF,NLEN,NNUM,JR,JPDS,JGDS,JENS, - & KR,KPDS,KGDS,KENS,LSKIP,LGRIB,IRGS) - IF(IRGS.EQ.0) K=KR+MNUM - IF(IRGI.EQ.1.AND.IRGS.EQ.0) MNUM=-1-MNUM - IF(IRGI.EQ.1.AND.IRGS.GT.0) MNUM=MNUM+NNUM - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C READ GRIB RECORD - IF(IRGI.GT.1) THEN - IRET=96 - ELSEIF(IRGS.NE.0) THEN - IRET=99 - ELSEIF(LGRIB.GT.JG) THEN - IRET=98 - ELSE - IRET=97 - CALL BAREAD(LUGB,LSKIP,LGRIB,KG,G) - IF(KG.EQ.LGRIB) IRET=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbp.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbp.f deleted file mode 100755 index fdfd486e17..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgbp.f +++ /dev/null @@ -1,209 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGBP(LUGB,LUGI,JG,J,JPDS,JGDS, - & KG,K,KPDS,KGDS,G,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGBP FINDS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE. ITS MESSAGE NUMBER IS RETURNED ALONG WITH THE UNPACKED -C PDS AND GDS PARAMETERS AND THE PACKED GRIB MESSAGE. IF THE GRIB -C MESSAGE IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGBP(LUGB,LUGI,JG,J,JPDS,JGDS, -C & KG,K,KPDS,KGDS,G,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JG INTEGER MAXIMUM NUMBER OF BYTES IN THE GRIB MESSAGE -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C OUTPUT ARGUMENTS: -C KG INTEGER NUMBER OF BYTES IN THE GRIB MESSAGE -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C G CHARACTER*1 (KG) GRIB MESSAGE -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF BYTES GREATER THAN JG -C 99 REQUEST NOT FOUND -C -C SUBPROGRAMS CALLED: -C GETGBMP FIND GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBMP AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER JPDS(200),JGDS(200),KPDS(200),KGDS(200) - CHARACTER G(JG) - PARAMETER(MBUF=256*1024) - CHARACTER CBUF(MBUF) - SAVE CBUF,NLEN,NNUM,MNUM - DATA LUX/0/ -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED - IF(LUGI.GT.0.AND.(J.LT.0.OR.LUGI.NE.LUX)) THEN - LUX=LUGI - JJ=MIN(J,-1-J) - ELSEIF(LUGI.LE.0.AND.(J.LT.0.OR.LUGB.NE.LUX)) THEN - LUX=LUGB - JJ=MIN(J,-1-J) - ELSE - JJ=J - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C FIND AND UNPACK GRIB MESSAGE - CALL GETGBMP(LUGB,LUGI,JG,JJ,JPDS,JGDS, - & MBUF,CBUF,NLEN,NNUM,MNUM, - & KG,K,KPDS,KGDS,G,IRET) - IF(IRET.EQ.96) LUX=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgi.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgi.f deleted file mode 100755 index 0c47dd7063..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgi.f +++ /dev/null @@ -1,88 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGI READS A GRIB INDEX FILE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: READ A GRIB INDEX FILE AND RETURN ITS CONTENTS. -C VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT: -C 81-BYTE S.LORD HEADER WITH 'GB1IX1' IN COLUMNS 42-47 FOLLOWED BY -C 81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS, -C NUMBER OF BYTES IN EACH INDEX RECORD, NUMBER OF INDEX RECORDS, -C AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40). -C EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE -C AND HAS THE INTERNAL FORMAT: -C BYTE 001-004: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 005-008: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 009-012: BYTES TO SKIP IN MESSAGE BEFORE GDS (0 IF NO GDS) -C BYTE 013-016: BYTES TO SKIP IN MESSAGE BEFORE BMS (0 IF NO BMS) -C BYTE 017-020: BYTES TO SKIP IN MESSAGE BEFORE BDS -C BYTE 021-024: BYTES TOTAL IN THE MESSAGE -C BYTE 025-025: GRIB VERSION NUMBER -C BYTE 026-053: PRODUCT DEFINITION SECTION (PDS) -C BYTE 054-095: GRID DEFINITION SECTION (GDS) (OR NULLS) -C BYTE 096-101: FIRST PART OF THE BIT MAP SECTION (BMS) (OR NULLS) -C BYTE 102-112: FIRST PART OF THE BINARY DATA SECTION (BDS) -C BYTE 113-172: (OPTIONAL) BYTES 41-100 OF THE PDS -C BYTE 173-184: (OPTIONAL) BYTES 29-40 OF THE PDS -C BYTE 185-320: (OPTIONAL) BYTES 43-178 OF THE GDS -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 -C -C USAGE: CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRET) -C INPUT ARGUMENTS: -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C MNUM INTEGER NUMBER OF INDEX RECORDS TO SKIP (USUALLY 0) -C MBUF INTEGER LENGTH OF CBUF IN BYTES -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 1 CBUF TOO SMALL TO HOLD INDEX BUFFER -C 2 ERROR READING INDEX FILE BUFFER -C 3 ERROR READING INDEX FILE HEADER -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - CHARACTER CBUF(MBUF) - CHARACTER CHEAD*162 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - NLEN=0 - NNUM=0 - IRET=3 - CALL BAREAD(LUGI,0,162,LHEAD,CHEAD) - IF(LHEAD.EQ.162.AND.CHEAD(42:47).EQ.'GB1IX1') THEN - READ(CHEAD(82:162),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM - IF(IOS.EQ.0) THEN - NSKP=NSKP+MNUM*NLEN - NNUM=NNUM-MNUM - NBUF=NNUM*NLEN - IRET=0 - IF(NBUF.GT.MBUF) THEN - NNUM=MBUF/NLEN - NBUF=NNUM*NLEN - IRET=1 - ENDIF - IF(NBUF.GT.0) THEN - CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF) - IF(LBUF.NE.NBUF) IRET=2 - ENDIF - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgir.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgir.f deleted file mode 100755 index e23871cee1..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/getgir.f +++ /dev/null @@ -1,90 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGIR READS A GRIB INDEX FILE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS. -C THE INDEX BUFFER RETURNED CONTAINS INDEX RECORDS WITH THE INTERNAL FORMAT: -C BYTE 001-004: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 005-008: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 009-012: BYTES TO SKIP IN MESSAGE BEFORE GDS (0 IF NO GDS) -C BYTE 013-016: BYTES TO SKIP IN MESSAGE BEFORE BMS (0 IF NO BMS) -C BYTE 017-020: BYTES TO SKIP IN MESSAGE BEFORE BDS -C BYTE 021-024: BYTES TOTAL IN THE MESSAGE -C BYTE 025-025: GRIB VERSION NUMBER -C BYTE 026-053: PRODUCT DEFINITION SECTION (PDS) -C BYTE 054-095: GRID DEFINITION SECTION (GDS) (OR NULLS) -C BYTE 096-101: FIRST PART OF THE BIT MAP SECTION (BMS) (OR NULLS) -C BYTE 102-112: FIRST PART OF THE BINARY DATA SECTION (BDS) -C BYTE 113-172: (OPTIONAL) BYTES 41-100 OF THE PDS -C BYTE 173-184: (OPTIONAL) BYTES 29-40 OF THE PDS -C BYTE 185-320: (OPTIONAL) BYTES 43-178 OF THE GDS -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 -C -C USAGE: CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB FILE -C MSK1 INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE -C MSK2 INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES -C MNUM INTEGER NUMBER OF INDEX RECORDS TO SKIP (USUALLY 0) -C MBUF INTEGER LENGTH OF CBUF IN BYTES -C OUTPUT ARGUMENTS: -C CBUF CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER NUMBER OF INDEX RECORDS -C (=0 IF NO GRIB MESSAGES ARE FOUND) -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 1 CBUF TOO SMALL TO HOLD INDEX DATA -C -C SUBPROGRAMS CALLED: -C SKGB SEEK NEXT GRIB MESSAGE -C IXGB MAKE INDEX RECORD -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - CHARACTER CBUF(MBUF) - PARAMETER(MINDEX=320) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SEARCH FOR FIRST GRIB MESSAGE - ISEEK=0 - CALL SKGB(LUGB,ISEEK,MSK1,LSKIP,LGRIB) - IF(LGRIB.GT.0.AND.MINDEX.LE.MBUF) THEN - CALL IXGB(LUGB,LSKIP,LGRIB,MINDEX,1,NLEN,CBUF) - ELSE - NLEN=MINDEX - ENDIF - DO M=1,MNUM - IF(LGRIB.GT.0) THEN - ISEEK=LSKIP+LGRIB - CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB) - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C MAKE AN INDEX RECORD FOR EVERY GRIB RECORD FOUND - NNUM=0 - IRET=0 - DOWHILE(IRET.EQ.0.AND.LGRIB.GT.0) - IF(NLEN*(NNUM+1).LE.MBUF) THEN - NNUM=NNUM+1 - CALL IXGB(LUGB,LSKIP,LGRIB,NLEN,NNUM,MLEN,CBUF) - ISEEK=LSKIP+LGRIB - CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB) - ELSE - IRET=1 - ENDIF - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/grib1.doc b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/grib1.doc deleted file mode 100755 index d9e07029fa..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/grib1.doc +++ /dev/null @@ -1,1321 +0,0 @@ - GRIB1 USERS GUIDE (FORTRAN 90) - -Contents: - -- Introduction -- GRIB1 Encoding Routines -- GRIB1 Decoding Routine -- Extracting GRIB1 Fields from a GRIB1 file -- GRIB1 Tables -- GRIB1 Routine Docblocks - -=============================================================================== - - Introduction - -This document briefly describes the routines available for encoding/decoding -GRIB Edition 1 messages. A basic familiarity with GRIB is assumed. - -A GRIB message is a machine independent format for storing -one or more gridded data fields. Each GRIB message consists of the -following sections: - -SECTION 0 - Indicator Section -SECTION 1 - Product Definition Section (PDS) -SECTION 2 - Grid Definition Section (GDS) -SECTION 3 - Bit-map Section (Optional) -SECTION 4 - Binary Data Section -SECTION 5 - End Section - -=============================================================================== - - GRIB1 Encoding Routines - -There are several routines that one can use to encode a GRIB1 message. -Subroutine W3FI72 can be used to encode a GRIB1 message which is passed -back to the calling program in a character array. -It is the users responsibility to ensure that the character array that will -hold the packed GRIB1 message has been allocated large enough prior to -calling W3FI72. - -Another option is subroutine PUTGB. PUTGB encodes a GRIB1 message and writes -it to a file. The message is not returned to the calling routine. -The output GRIB1 data file must be opened with a call to subroutine BAOPEN -(or BAOPENW) prior to the call to PUTGB. A call to BACLOSE is recommended at -the end of the program to close the output file properly. - -Example usage: - - integer,dimension(200) :: KPDS,KGDS - logical*1,allocatable :: LB(:) ! bitmap - real,allocatable :: F(:) ! grid point data values - lugb=50 - ! Open GRIB1 file - call baopenw(LUGB,"filename",iret) - - ! Set up bitmap and data field - numpts=?????? - allocate(LB(numpts)) - allocate(F(numpts)) - - ! Set GRIB1 field identification values to encode - KPDS(?)= - KGDS(?)= - - ! pack and write field to file - CALL PUTGB(LUGB,numpts,KPDS,KGDS,LB,F,iret) - - ! Close file ... - call baclose(LUGB,iret) - - stop - end - -There are other similar routines in the PUTGB family that can be used to -encode GRIB1 messages and write them out to a file: -PUTGBEX - Used to encode GRIB1 messages with NCEP PDS - extensions to specify ensemble information. -PUTGN - Allows users to specify a binary scale factor or limit amount of - space each data point should occupy. - -Please see the "GRIB1 Routine Docblocks" section below for subroutine -argument usage for the routines mentioned above. - -=============================================================================== - - GRIB1 Decoding Routine - -Subroutine W3FI63 can be used to decode a given GRIB1 message that resides -in a character array in memory. This routine will return the unpacked values -in the PDS and GDS, a bitmap array, and the unpacked grid point data values. - -It is the users responsibility to ensure that the returned arrays have -been allocated large enough prior to calling W3FI63. - -Please see the "GRIB1 Routine Docblocks" section below for subroutine -argument usage for the routine mentioned above. - -=============================================================================== - - Extracting GRIB1 Fields from a GRIB1 file - -Subroutine GETGB can be used to extract a specified field from a file -containing many GRIB1 messages. GETGB searches an index to find the -location of the user specified field. The index can be supplied from a -separate GRIB1 index file, or it can be generated internally. - -The GRIB1 data file ( and the index file, if supplied ) must be opened with -a call to subroutine BAOPEN prior to the call to GETGB. - -Users can request a particular field by specifying the PDS and GDS -values that they wish to match. GETGB will return the PDS, GDS, bitmap, -and grid point data values. - - -Example usage: - - integer,parameter :: MAXPTS=?????? - integer,dimension(200) :: JPDS,JGDS,KPDS,KGDS - logical*1,dimension(MAXPTS) :: LB ! bitmap - real,dimension(MAXPTS) :: F ! grid point data values - lugb=10 - lugi=0 - ! Open GRIB1 file - call baopenr(LUGB,"filename",iret) - - ! Set GRIB1 field identification values to search for - j=0 ! search from beginning - jpds(?)= - jgds(?)= - - ! Get field from file - CALL GETGB(LUGB,LUGI,MAXPTS,J,JPDS,JGDS, - & KF,K,KPDS,KGDS,LB,F,IRET) - - ! Process field ... - firstval=F(1) - lastval=F(KF) - fldmax=maxval(F) - fldmin=minval(F) - - stop - end - -There are other similar routines in the GETGB family that can be used to -extract data from a GRIB1 file: -GETGBEX - Used to search for and decode GRIB1 messages using NCEP PDS - extensions used to specify ensemble information. -GETGBP - Returns the requested packed GRIB message instead of the unpacked - bitmap and data values. -GETGBH - Returns the full PDS and GDS values of the requested field - without having to unpack the bitmap and grid point data values. - - -Please see the "GRIB1 Routine Docblocks" section below for subroutine -argument usage for the routines mentioned above. - -=============================================================================== - - GRIB1 Tables - -WMO's GRIB1 guide "A GUIDE TO THE CODE FORM FM 92-IX Ext. GRIB" -contains a description of the GRIB1 code form and the master code -table information. This document can be found at -http://www.wmo.ch/web/www/WDM/Guides/Guide-binary.html - -In addition, NCEP Office Note 388 (http://www.nco.ncep.noaa.gov/pmb/docs/on388) -also contains a description of GRIB1 along with master and local NCEP -Code Table values. - -=============================================================================== - - GRIB1 Routine Docblocks - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI72 MAKE A COMPLETE GRIB MESSAGE -C PRGMMR: FARLEY ORG: NMC421 DATE:94-11-22 -C -C ABSTRACT: MAKES A COMPLETE GRIB MESSAGE FROM A USER SUPPLIED -C ARRAY OF FLOATING POINT OR INTEGER DATA. THE USER HAS THE -C OPTION OF SUPPLYING THE PDS OR AN INTEGER ARRAY THAT WILL BE -C USED TO CREATE A PDS (WITH W3FI68). THE USER MUST ALSO -C SUPPLY OTHER NECESSARY INFO; SEE USAGE SECTION BELOW. -C -C PROGRAM HISTORY LOG: -C 91-05-08 R.E.JONES -C 92-07-01 M. FARLEY ADDED GDS AND BMS LOGIC. PLACED EXISTING -C LOGIC FOR BDS IN A ROUTINE. -C 92-10-02 R.E.JONES ADD ERROR EXIT FOR W3FI73 -C 93-04-30 R.E.JONES REPLACE DO LOOPS TO MOVE CHARACTER DATA -C WITH XMOVEX, USE XSTORE TO ZERO CHARACTER -C ARRAY. MAKE CHANGE SO FLAT FIELD WILL PACK. -C 93-08-06 CAVANAUGH MODIFIED CALL TO W3FI75 -C 93-10-26 CAVANAUGH ADDED CODE TO RESTORE INPUT FIELD TO ORIGINAL -C VALUES IF D-SCALE NOT 0 -C 94-01-27 CAVANAUGH ADDED IGDS ARRAY IN CALL TO W3FI75 TO PROVIDE -C INFORMATION FOR BOUSTROPHEDONIC PROCESSING -C 94-03-03 CAVANAUGH INCREASED SIZE OF GDS ARRAY FOR THIN GRIDS -C 94-05-16 FARLEY CLEANED UP DOCUMENTATION -C 94-11-10 FARLEY INCREASED SIZE OF PFLD/IFLD ARRARYS FROM -C 100K TO 260K FOR .5 DEGREE SST ANAL FIELDS -C 94-12-04 R.E.JONES CHANGE DOCUMENT FOR IPFLAG. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-05-19 Gilbert Increased array dimensions to handle grids -C of up to 500,000 grid points. -C 95-10-31 IREDELL GENERALIZED WORD SIZE -C 98-12-21 Gilbert Replaced Function ICHAR with mova2i. -C 99-02-01 Gilbert Changed the method of zeroing out array KBUF. -C the old method, using W3FI01 and XSTORE was -C incorrect with 4-byte integers and 8-byte reals. -C 2001-06-07 Gilbert Removed calls to xmovex. -C changed IPFLD from integer to character. -C -C USAGE: CALL W3FI72(ITYPE,FLD,IFLD,IBITL, -C & IPFLAG,ID,PDS, -C & IGFLAG,IGRID,IGDS,ICOMP, -C & IBFLAG,IBMAP,IBLEN,IBDSFL, -C & IBDSFL, -C & NPTS,KBUF,ITOT,JERR) -C -C INPUT ARGUMENT LIST: -C ITYPE - 0 = FLOATING POINT DATA SUPPLIED IN ARRAY 'FLD' -C 1 = INTEGER DATA SUPPLIED IN ARRAY 'IFLD' -C FLD - REAL ARRAY OF DATA (AT PROPER GRIDPOINTS) TO BE -C CONVERTED TO GRIB FORMAT IF ITYPE=0. -C SEE REMARKS #1 & 2. -C IFLD - INTEGER ARRAY OF DATA (AT PROPER GRIDPOINTS) TO BE -C CONVERTED TO GRIB FORMAT IF ITYPE=1. -C SEE REMARKS #1 & 2. -C IBITL - 0 = COMPUTER COMPUTES LENGTH FOR PACKING DATA FROM -C POWER OF 2 (NUMBER OF BITS) BEST FIT OF DATA -C USING 'VARIABLE' BIT PACKER W3FI58. -C 8, 12, ETC. COMPUTER RESCALES DATA TO FIT INTO THAT -C 'FIXED' NUMBER OF BITS USING W3FI59. -C SEE REMARKS #3. -C -C IPFLAG - 0 = MAKE PDS FROM USER SUPPLIED ARRAY (ID) -C 1 = USER SUPPLYING PDS -C NOTE: IF PDS IS GREATER THAN 30, USE IPLFAG=1. -C THE USER COULD CALL W3FI68 BEFORE HE CALLS -C W3FI72. THIS WOULD MAKE THE FIRST 30 BYTES OF -C THE PDS, USER THEN WOULD MAKE BYTES AFTER 30. -C ID - INTEGER ARRAY OF VALUES THAT W3FI68 WILL USE -C TO MAKE AN EDITION 1 PDS IF IPFLAG=0. (SEE THE -C DOCBLOCK FOR W3FI68 FOR LAYOUT OF ARRAY) -C PDS - CHARACTER ARRAY OF VALUES (VALID PDS SUPPLIED -C BY USER) IF IPFLAG=1. LENGTH MAY EXCEED 28 BYTES -C (CONTENTS OF BYTES BEYOND 28 ARE PASSED -C THROUGH UNCHANGED). -C -C IGFLAG - 0 = MAKE GDS BASED ON 'IGRID' VALUE. -C 1 = MAKE GDS FROM USER SUPPLIED INFO IN 'IGDS' -C AND 'IGRID' VALUE. -C SEE REMARKS #4. -C IGRID - # = GRID IDENTIFICATION (TABLE B) -C 255 = IF USER DEFINED GRID; IGDS MUST BE SUPPLIED -C AND IGFLAG MUST =1. -C IGDS - INTEGER ARRAY CONTAINING USER GDS INFO (SAME -C FORMAT AS SUPPLIED BY W3FI71 - SEE DOCKBLOCK FOR -C LAYOUT) IF IGFLAG=1. -C ICOMP - RESOLUTION AND COMPONENT FLAG FOR BIT 5 OF GDS(17) -C 0 = EARTH ORIENTED WINDS -C 1 = GRID ORIENTED WINDS -C -C IBFLAG - 0 = MAKE BIT MAP FROM USER SUPPLIED DATA -C # = BIT MAP PREDEFINED BY CENTER -C SEE REMARKS #5. -C IBMAP - INTEGER ARRAY CONTAINING BIT MAP -C IBLEN - LENGTH OF BIT MAP WILL BE USED TO VERIFY LENGTH -C OF FIELD (ERROR IF IT DOESN'T MATCH). -C -C IBDSFL - INTEGER ARRAY CONTAINING TABLE 11 FLAG INFO -C BDS OCTET 4: -C (1) 0 = GRID POINT DATA -C 1 = SPHERICAL HARMONIC COEFFICIENTS -C (2) 0 = SIMPLE PACKING -C 1 = SECOND ORDER PACKING -C (3) ... SAME VALUE AS 'ITYPE' -C 0 = ORIGINAL DATA WERE FLOATING POINT VALUES -C 1 = ORIGINAL DATA WERE INTEGER VALUES -C (4) 0 = NO ADDITIONAL FLAGS AT OCTET 14 -C 1 = OCTET 14 CONTAINS FLAG BITS 5-12 -C (5) 0 = RESERVED - ALWAYS SET TO 0 -C BYTE 6 OPTION 1 NOT AVAILABLE (AS OF 5-16-93) -C (6) 0 = SINGLE DATUM AT EACH GRID POINT -C 1 = MATRIX OF VALUES AT EACH GRID POINT -C BYTE 7 OPTION 0 WITH SECOND ORDER PACKING N/A (AS OF 5-16-93) -C (7) 0 = NO SECONDARY BIT MAPS -C 1 = SECONDARY BIT MAPS PRESENT -C (8) 0 = SECOND ORDER VALUES HAVE CONSTANT WIDTH -C 1 = SECOND ORDER VALUES HAVE DIFFERENT WIDTHS -C -C OUTPUT ARGUMENT LIST: -C NPTS - NUMBER OF GRIDPOINTS IN ARRAY FLD OR IFLD -C KBUF - ENTIRE GRIB MESSAGE ('GRIB' TO '7777') -C EQUIVALENCE TO INTEGER ARRAY TO MAKE SURE IT -C IS ON WORD BOUNARY. -C ITOT - TOTAL LENGTH OF GRIB MESSAGE IN BYTES -C JERR - = 0, COMPLETED MAKING GRIB FIELD WITHOUT ERROR -C 1, IPFLAG NOT 0 OR 1 -C 2, IGFLAG NOT 0 OR 1 -C 3, ERROR CONVERTING IEEE F.P. NUMBER TO IBM370 F.P. -C 4, W3FI71 ERROR/IGRID NOT DEFINED -C 5, W3FK74 ERROR/GRID REPRESENTATION TYPE NOT VALID -C 6, GRID TOO LARGE FOR PACKER DIMENSION ARRAYS -C SEE AUTOMATION DIVISION FOR REVISION! -C 7, LENGTH OF BIT MAP NOT EQUAL TO SIZE OF FLD/IFLD -C 8, W3FI73 ERROR, ALL VALUES IN IBMAP ARE ZERO -C -C OUTPUT FILES: -C FT06F001 - STANDARD FORTRAN OUTPUT PRINT FILE -C -C SUBPROGRAMS CALLED: -C LIBRARY: -C W3LIB - W3FI58, W3FI59, W3FI68, W3FI71, W3FI73, W3FI74 -C W3FI75, W3FI76 -C FORTRAN 90 INTRINSIC - BIT_SIZE -C -C REMARKS: -C 1) IF BIT MAP TO BE INCLUDED IN MESSAGE, NULL DATA SHOULD -C BE INCLUDED IN FLD OR IFLD. THIS ROUTINE WILL TAKE CARE -C OF 'DISCARDING' ANY NULL DATA BASED ON THE BIT MAP. -C 2) UNITS MUST BE THOSE IN GRIB DOCUMENTATION: NMC O.N. 388 -C OR WMO PUBLICATION 306. -C 3) IN EITHER CASE, INPUT NUMBERS WILL BE MULTIPLIED BY -C '10 TO THE NTH' POWER FOUND IN ID(25) OR PDS(27-28), -C THE D-SCALING FACTOR, PRIOR TO BINARY PACKING. -C 4) ALL NMC PRODUCED GRIB FIELDS WILL HAVE A GRID DEFINITION -C SECTION INCLUDED IN THE GRIB MESSAGE. ID(6) WILL BE -C SET TO '1'. -C - GDS WILL BE BUILT BASED ON GRID NUMBER (IGRID), UNLESS -C IGFLAG=1 (USER SUPPLYING IGDS). USER MUST STILL SUPPLY -C IGRID EVEN IF IGDS PROVIDED. -C 5) IF BIT MAP USED THEN ID(7) OR PDS(8) MUST INDICATE THE -C PRESENCE OF A BIT MAP. -C 6) ARRAY KBUF SHOULD BE EQUIVALENCED TO AN INTEGER VALUE OR -C ARRAY TO MAKE SURE IT IS ON A WORD BOUNDARY. -C 7) SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGB PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGB. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL PUTGB(LUGB,KF,KPDS,KGDS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - - - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI63 UNPK GRIB FIELD TO GRIB GRID -C PRGMMR: FARLEY ORG: NMC421 DATE:94-11-22 -C -C ABSTRACT: UNPACK A GRIB (EDITION 1) FIELD TO THE EXACT GRID -C SPECIFIED IN THE GRIB MESSAGE, ISOLATE THE BIT MAP, AND MAKE -C THE VALUES OF THE PRODUCT DESCRIPTON SECTION (PDS) AND THE -C GRID DESCRIPTION SECTION (GDS) AVAILABLE IN RETURN ARRAYS. -C -C WHEN DECODING IS COMPLETED, DATA AT EACH GRID POINT HAS BEEN -C RETURNED IN THE UNITS SPECIFIED IN THE GRIB MANUAL. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 91-11-12 CAVANAUGH MODIFIED SIZE OF ECMWF GRIDS 5-8 -C 91-12-22 CAVANAUGH CORRECTED PROCESSING OF MERCATOR PROJECTIONS -C IN GRID DEFINITION SECTION (GDS) IN -C ROUTINE FI633 -C 92-08-05 CAVANAUGH CORRECTED MAXIMUM GRID SIZE TO ALLOW FOR -C ONE DEGREE BY ONE DEGREE GLOBAL GRIDS -C 92-08-27 CAVANAUGH CORRECTED TYPO ERROR, ADDED CODE TO COMPARE -C TOTAL BYTE SIZE FROM SECTION 0 WITH SUM OF -C SECTION SIZES. -C 92-10-21 CAVANAUGH CORRECTIONS WERE MADE (IN FI634) TO REDUCE -C PROCESSING TIME FOR INTERNATIONAL GRIDS. -C REMOVED A TYPOGRAPHICAL ERROR IN FI635. -C 93-01-07 CAVANAUGH CORRECTIONS WERE MADE (IN FI635) TO -C FACILITATE USE OF THESE ROUTINES ON A PC. -C A TYPOGRAPHICAL ERROR WAS ALSO CORRECTED -C 93-01-13 CAVANAUGH CORRECTIONS WERE MADE (IN FI632) TO -C PROPERLY HANDLE CONDITION WHEN -C TIME RANGE INDICATOR = 10. -C ADDED U.S.GRID 87. -C 93-02-04 CAVANAUGH ADDED U.S.GRIDS 85 AND 86 -C 93-02-26 CAVANAUGH ADDED GRIDS 2, 3, 37 THRU 44,AND -C GRIDS 55, 56, 90, 91, 92, AND 93 TO -C LIST OF U.S. GRIDS. -C 93-04-07 CAVANAUGH ADDED GRIDS 67 THRU 77 TO -C LIST OF U.S. GRIDS. -C 93-04-20 CAVANAUGH INCREASED MAX SIZE TO ACCOMODATE -C GAUSSIAN GRIDS. -C 93-05-26 CAVANAUGH CORRECTED GRID RANGE SELECTION IN FI634 -C FOR RANGES 67-71 & 75-77 -C 93-06-08 CAVANAUGH CORRECTED FI635 TO ACCEPT GRIB MESSAGES -C WITH SECOND ORDER PACKING. ADDED ROUTINE FI636 -C TO PROCESS MESSAGES WITH SECOND ORDER PACKING. -C 93-09-22 CAVANAUGH MODIFIED TO EXTRACT SUB-CENTER NUMBER FROM -C PDS BYTE 26 -C 93-10-13 CAVANAUGH MODIFIED FI634 TO CORRECT GRID SIZES FOR -C GRIDS 204 AND 208 -C 93-10-14 CAVANAUGH INCREASED SIZE OF KGDS TO INCLUDE ENTRIES FOR -C NUMBER OF POINTS IN GRID AND NUMBER OF WORDS -C IN EACH ROW -C 93-12-08 CAVANAUGH CORRECTED TEST FOR EDITION NUMBER INSTEAD -C OF VERSION NUMBER -C 93-12-15 CAVANAUGH MODIFIED SECOND ORDER POINTERS TO FIRST ORDER -C VALUES AND SECOND ORDER VALUES CORRECTLY -C IN ROUTINE FI636 -C 94-03-02 CAVANAUGH ADDED CALL TO W3FI83 WITHIN DECODER. USER -C NO LONGER NEEDS TO MAKE CALL TO THIS ROUTINE -C 94-04-22 CAVANAUGH MODIFIED FI635, FI636 TO PROCESS ROW BY ROW -C SECOND ORDER PACKING, ADDED SCALING CORRECTION -C TO FI635, AND CORRECTED TYPOGRAPHICAL ERRORS -C IN COMMENT FIELDS IN FI634 -C 94-05-17 CAVANAUGH CORRECTED ERROR IN FI633 TO EXTRACT RESOLUTION -C FOR LAMBERT-CONFORMAL GRIDS. ADDED CLARIFYING -C INFORMATION TO DOCBLOCK ENTRIES -C 94-05-25 CAVANAUGH ADDED CODE TO PROCESS COLUMN BY COLUMN AS WELL -C AS ROW BY ROW ORDERING OF SECOND ORDER DATA -C 94-06-27 CAVANAUGH ADDED PROCESSING FOR GRIDS 45, 94 AND 95. -C INCLUDES CONSTRUCTION OF SECOND ORDER BIT MAPS -C FOR THINNED GRIDS IN FI636. -C 94-07-08 CAVANAUGH COMMENTED OUT PRINT OUTS USED FOR DEBUGGING -C 94-09-08 CAVANAUGH ADDED GRIDS 220, 221, 223 FOR FNOC -C 94-11-10 FARLEY INCREASED MXSIZE FROM 72960 TO 260000 -C FOR .5 DEGREE SST ANALYSIS FIELDS -C 94-12-06 R.E.JONES CHANGES IN FI632 FOR PDS GREATER THAN 28 -C 95-02-14 R.E.JONES CORRECT IN FI633 FOR NAVY WAFS GRIB -C 95-03-20 M.BALDWIN FI633 MODIFICATION TO GET -C DATA REP TYPES [KGDS(1)] 201 AND 202 TO WORK. -C 95-04-10 E.ROGERS ADDED GRIDS 96 AND 97 FOR ETA MODEL IN FI634. -C 95-04-26 R.E.JONES FI636 CORECTION FOR 2ND ORDER COMPLEX -C UNPACKING. R -C 95-05-19 R.E.JONES ADDED GRID 215, 20 KM AWIPS GRID -C 95-07-06 R.E.JONES ADDED GAUSSIAN T62, T126 GRID 98, 126 -C 95-10-19 R.E.JONES ADDED GRID 216, 45 KM ETA AWIPS ALASKA GRID -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 96-03-07 R.E.JONES CONTINUE UNPACK WITH KRET ERROR 9 IN FI631. -C 96-08-19 R.E.JONES ADDED MERCATOR GRIDS 8 AND 53, AND GRID 196 -C 97-02-12 W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING -C 98-06-17 IREDELL REMOVED ALTERNATE RETURN IN FI637 -C 98-08-31 IREDELL ELIMINATED NEED FOR MXSIZE -C 98-09-02 Gilbert Corrected error in map size for U.S. Grid 92 -C 98-09-08 BALDWIN ADD DATA REP TYPE [KGDS(1)] 203 -C 01-03-08 ROGERS CHANGED ETA GRIDS 90-97, ADDED ETA GRIDS -C 194, 198. ADDED AWIPS GRIDS 241,242,243, -C 245, 246, 247, 248, AND 250 -C 01-03-19 VUONG ADDED AWIPS GRIDS 238,239,240, AND 244. -C 2001-06-06 GILBERT CHanged gbyte/sbyte calls to refer to -C Wesley Ebisuzaki's endian independent -C versions gbytec/sbytec. -C Removed equivalences. -C 01-05-03 ROGERS ADDED GRID 249 (12KM FOR ALASKA) -C 01-10-10 ROGERS REDEFINED GRID 218 FOR 12 KM ETA -C REDEFINED GRID 192 FOR NEW 32-KM ETA GRID -C 02-03-27 VUONG ADDED RSAS GRID 88 AND AWIPS GRIDS 219, 220, -C 223, 224, 225, 226, 227, 228, 229, 230, 231, -C 232, 233, 234, 235, 251, AND 252 -C 02-08-06 ROGERS REDEFINED GRIDS 90-93,97,194,245-250 FOR THE -C 8KM HI-RES-WINDOW MODEL AND ADD AWIPS GRID 253 -C 2003-06-30 GILBERT SET NEW VALUES IN ARRAY KPTR TO PASS BACK ADDITIONAL -C PACKING INFO. -C KPTR(19) - BINARY SCALE FACTOR -C KPTR(20) - NUM BITS USED TO PACK EACH DATUM -C 2003-06-30 GILBERT ADDED GRIDS 145 and 146 for CMAQ -C and GRID 175 for AWIPS over GUAM. -C 2003-07-08 VUONG ADDED GRIDS 110, 127, 171, 172 AND MODIFIED GRID 170 -C -C USAGE: CALL W3FI63(MSGA,KPDS,KGDS,KBMS,DATA,KPTR,KRET) -C INPUT ARGUMENT LIST: -C MSGA - GRIB FIELD - "GRIB" THRU "7777" CHAR*1 -C (MESSAGE CAN BE PRECEDED BY JUNK CHARS) -C -C OUTPUT ARGUMENT LIST: -C DATA - ARRAY CONTAINING DATA ELEMENTS -C KPDS - ARRAY CONTAINING PDS ELEMENTS. (EDITION 1) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C (26-35) - RESERVED -C (36-N) - CONSECUTIVE BYTES EXTRACTED FROM PROGRAM -C DEFINITION SECTION (PDS) OF GRIB MESSAGE -C KGDS - ARRAY CONTAINING GDS ELEMENTS. -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C STAGGERED ARAKAWA ROTATED LAT/LON GRIDS (TYPE 203) -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF CENTER -C (8) - LO(2) LONGITUDE OF CENTER -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C KBMS - BITMAP DESCRIBING LOCATION OF OUTPUT ELEMENTS. -C (ALWAYS CONSTRUCTED) -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG (COPY OF BMS OCTETS 5,6) -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS (RIGHT ADJ COPY OF OCTET 4) -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C (16) - RESERVED -C (17) - RESERVED -C (18) - RESERVED -C (19) - BINARY SCALE FACTOR -C (20) - NUM BITS USED TO PACK EACH DATUM -C KRET - FLAG INDICATING QUALITY OF COMPLETION -C -C REMARKS: WHEN DECODING IS COMPLETED, DATA AT EACH GRID POINT HAS BEEN -C RETURNED IN THE UNITS SPECIFIED IN THE GRIB MANUAL. -C -C VALUES FOR RETURN FLAG (KRET) -C KRET = 0 - NORMAL RETURN, NO ERRORS -C = 1 - 'GRIB' NOT FOUND IN FIRST 100 CHARS -C = 2 - '7777' NOT IN CORRECT LOCATION -C = 3 - UNPACKED FIELD IS LARGER THAN 260000 -C = 4 - GDS/ GRID NOT ONE OF CURRENTLY ACCEPTED VALUES -C = 5 - GRID NOT CURRENTLY AVAIL FOR CENTER INDICATED -C = 8 - TEMP GDS INDICATED, BUT GDS FLAG IS OFF -C = 9 - GDS INDICATES SIZE MISMATCH WITH STD GRID -C =10 - INCORRECT CENTER INDICATOR -C =11 - BINARY DATA SECTION (BDS) NOT COMPLETELY PROCESSED. -C PROGRAM IS NOT SET TO PROCESS FLAG COMBINATIONS -C SHOWN IN OCTETS 4 AND 14. -C =12 - BINARY DATA SECTION (BDS) NOT COMPLETELY PROCESSED. -C PROGRAM IS NOT SET TO PROCESS FLAG COMBINATIONS -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ -C 4 AUG 1988 -C W3FI63 -C -C -C GRIB UNPACKING ROUTINE -C -C -C THIS ROUTINE WILL UNPACK A 'GRIB' FIELD TO THE EXACT GRID -C TYPE SPECIFIED IN THE MESSAGE, RETURN A BIT MAP AND MAKE THE -C VALUES OF THE PRODUCT DEFINITION SEC (PDS) AND THE GRID -C DESCRIPTION SEC (GDS) AVAILABLE IN RETURN ARRAYS. -C SEE "GRIB - THE WMO FORMAT FOR THE STORAGE OF WEATHER PRODUCT -C INFORMATION AND THE EXCHANGE OF WEATHER PRODUCT MESSAGES IN -C GRIDDED BINARY FORM" DATED JULY 1, 1988 BY JOHN D. STACKPOLE -C DOC, NOAA, NWS, NATIONAL METEOROLOGICAL CENTER. -C -C THE CALL TO THE GRIB UNPACKING ROUTINE IS AS FOLLOWS: -C -C CALL W3FI63(MSGA,KPDS,KGDS,LBMS,DATA,KPTR,KRET) -C -C INPUT: -C -C MSGA = CONTAINS THE GRIB MESSAGE TO BE UNPACKED. CHARACTERS -C "GRIB" MAY BEGIN ANYWHERE WITHIN FIRST 100 BYTES. -C -C OUTPUT: -C -C KPDS(100) INTEGER*4 -C ARRAY TO CONTAIN THE ELEMENTS OF THE PRODUCT -C DEFINITION SEC . -C (VERSION 1) -C KPDS(1) - ID OF CENTER -C KPDS(2) - MODEL IDENTIFICATION (SEE "GRIB" TABLE 1) -C KPDS(3) - GRID IDENTIFICATION (SEE "GRIB" TABLE 2) -C KPDS(4) - GDS/BMS FLAG -C BIT DEFINITION -C 25 0 - GDS OMITTED -C 1 - GDS INCLUDED -C 26 0 - BMS OMITTED -C 1 - BMS INCLUDED -C NOTE:- LEFTMOST BIT = 1, -C RIGHTMOST BIT = 32 -C KPDS(5) - INDICATOR OF PARAMETER (SEE "GRIB" TABLE 5) -C KPDS(6) - TYPE OF LEVEL (SEE "GRIB" TABLES 6 & 7) -C KPDS(7) - HEIGHT,PRESSURE,ETC OF LEVEL -C KPDS(8) - YEAR INCLUDING CENTURY -C KPDS(9) - MONTH OF YEAR -C KPDS(10) - DAY OF MONTH -C KPDS(11) - HOUR OF DAY -C KPDS(12) - MINUTE OF HOUR -C KPDS(13) - INDICATOR OF FORECAST TIME UNIT (SEE "GRIB" -C TABLE 8) -C KPDS(14) - TIME 1 (SEE "GRIB" TABLE 8A) -C KPDS(15) - TIME 2 (SEE "GRIB" TABLE 8A) -C KPDS(16) - TIME RANGE INDICATOR (SEE "GRIB" TABLE 8A) -C KPDS(17) - NUMBER INCLUDED IN AVERAGE -C KPDS(18) - EDITION NR OF GRIB SPECIFICATION -C KPDS(19) - VERSION NR OF PARAMETER TABLE -C -C KGDS(13) INTEGER*4 -C ARRAY CONTAINING GDS ELEMENTS. -C -C KGDS(1) - DATA REPRESENTATION TYPE -C -C LATITUDE/LONGITUDE GRIDS (SEE "GRIB" TABLE 10) -C KGDS(2) - N(I) NUMBER OF POINTS ON LATITUDE -C CIRCLE -C KGDS(3) - N(J) NUMBER OF POINTS ON LONGITUDE -C CIRCLE -C KGDS(4) - LA(1) LATITUDE OF ORIGIN -C KGDS(5) - LO(1) LONGITUDE OF ORIGIN -C KGDS(6) - RESOLUTION FLAG -C BIT MEANING -C 25 0 - DIRECTION INCREMENTS NOT -C GIVEN -C 1 - DIRECTION INCREMENTS GIVEN -C KGDS(7) - LA(2) LATITUDE OF EXTREME POINT -C KGDS(8) - LO(2) LONGITUDE OF EXTREME POINT -C KGDS(9) - DI LONGITUDINAL DIRECTION INCREMENT -C KGDS(10) - REGULAR LAT/LON GRID -C DJ - LATITUDINAL DIRECTION -C INCREMENT -C GAUSSIAN GRID -C N - NUMBER OF LATITUDE CIRCLES -C BETWEEN A POLE AND THE EQUATOR -C KGDS(11) - SCANNING MODE FLAG -C BIT MEANING -C 25 0 - POINTS ALONG A LATITUDE -C SCAN FROM WEST TO EAST -C 1 - POINTS ALONG A LATITUDE -C SCAN FROM EAST TO WEST -C 26 0 - POINTS ALONG A MERIDIAN -C SCAN FROM NORTH TO SOUTH -C 1 - POINTS ALONG A MERIDIAN -C SCAN FROM SOUTH TO NORTH -C 27 0 - POINTS SCAN FIRST ALONG -C CIRCLES OF LATITUDE, THEN -C ALONG MERIDIANS -C (FORTRAN: (I,J)) -C 1 - POINTS SCAN FIRST ALONG -C MERIDIANS THEN ALONG -C CIRCLES OF LATITUDE -C (FORTRAN: (J,I)) -C -C POLAR STEREOGRAPHIC GRIDS (SEE GRIB TABLE 12) -C KGDS(2) - N(I) NR POINTS ALONG LAT CIRCLE -C KGDS(3) - N(J) NR POINTS ALONG LON CIRCLE -C KGDS(4) - LA(1) LATITUDE OF ORIGIN -C KGDS(5) - LO(1) LONGITUDE OF ORIGIN -C KGDS(6) - RESERVED -C KGDS(7) - LOV GRID ORIENTATION -C KGDS(8) - DX - X DIRECTION INCREMENT -C KGDS(9) - DY - Y DIRECTION INCREMENT -C KGDS(10) - PROJECTION CENTER FLAG -C KGDS(11) - SCANNING MODE -C -C SPHERICAL HARMONIC COEFFICIENTS (SEE "GRIB" TABLE 14) -C KGDS(2) - J PENTAGONAL RESOLUTION PARAMETER -C KGDS(3) - K PENTAGONAL RESOLUTION PARAMETER -C KGDS(4) - M PENTAGONAL RESOLUTION PARAMETER -C KGDS(5) - REPRESENTATION TYPE -C KGDS(6) - COEFFICIENT STORAGE MODE -C -C MERCATOR GRIDS -C KGDS(2) - N(I) NR POINTS ON LATITUDE CIRCLE -C KGDS(3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C KGDS(4) - LA(1) LATITUDE OF ORIGIN -C KGDS(5) - LO(1) LONGITUDE OF ORIGIN -C KGDS(6) - RESOLUTION FLAG -C KGDS(7) - LA(2) LATITUDE OF LAST GRID POINT -C KGDS(8) - LO(2) LONGITUDE OF LAST GRID POINT -C KGDS(9) - LATIN - LATITUDE OF PROJECTION INTERSECTION -C KGDS(10) - RESERVED -C KGDS(11) - SCANNING MODE FLAG -C KGDS(12) - LONGITUDINAL DIR GRID LENGTH -C KGDS(13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C KGDS(2) - NX NR POINTS ALONG X-AXIS -C KGDS(3) - NY NR POINTS ALONG Y-AXIS -C KGDS(4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C KGDS(5) - LO1 LON OF ORIGIN (LOWER LEFT) -C KGDS(6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C KGDS(7) - LOV - ORIENTATION OF GRID -C KGDS(8) - DX - X-DIR INCREMENT -C KGDS(9) - DY - Y-DIR INCREMENT -C KGDS(10) - PROJECTION CENTER FLAG -C KGDS(11) - SCANNING MODE FLAG -C KGDS(12) - LATIN 1 - FIRST LAT FROM POLE OF -C SECANT CONE INTERSECTION -C KGDS(13) - LATIN 2 - SECOND LAT FROM POLE OF -C SECANT CONE INTERSECTION -C -C LBMS(*) LOGICAL -C ARRAY TO CONTAIN THE BIT MAP DESCRIBING THE -C PLACEMENT OF DATA IN THE OUTPUT ARRAY. IF A -C BIT MAP IS NOT INCLUDED IN THE SOURCE MESSAGE, -C ONE WILL BE GENERATED AUTOMATICALLY BY THE -C UNPACKING ROUTINE. -C -C -C DATA(*) REAL*4 -C THIS ARRAY WILL CONTAIN THE UNPACKED DATA POINTS. -C -C NOTE:- 65160 IS MAXIMUN FIELD SIZE ALLOWABLE -C -C KPTR(10) INTEGER*4 -C ARRAY CONTAINING STORAGE FOR THE FOLLOWING -C PARAMETERS. -C -C (1) - UNUSED -C (2) - UNUSED -C (3) - LENGTH OF PDS (IN BYTES) -C (4) - LENGTH OF GDS (IN BYTES) -C (5) - LENGTH OF BMS (IN BYTES) -C (6) - LENGTH OF BDS (IN BYTES) -C (7) - USED BY UNPACKING ROUTINE -C (8) - NUMBER OF DATA POINTS FOR GRID -C (9) - "GRIB" CHARACTERS START IN BYTE NUMBER -C (10) - USED BY UNPACKING ROUTINE -C -C -C KRET INTEGER*4 -C THIS VARIABLE WILL CONTAIN THE RETURN INDICATOR. -C -C 0 - NO ERRORS DETECTED. -C -C 1 - 'GRIB' NOT FOUND IN FIRST 100 -C CHARACTERS. -C -C 2 - '7777' NOT FOUND, EITHER MISSING OR -C TOTAL OF SEC COUNTS OF INDIVIDUAL -C SECTIONS IS INCORRECT. -C -C 3 - UNPACKED FIELD IS LARGER THAN 65160. -C -C 4 - IN GDS, DATA REPRESENTATION TYPE -C NOT ONE OF THE CURRENTLY ACCEPTABLE -C VALUES. SEE "GRIB" TABLE 9. VALUE -C OF INCORRECT TYPE RETURNED IN KGDS(1). -C -C 5 - GRID INDICATED IN KPDS(3) IS NOT -C AVAILABLE FOR THE CENTER INDICATED IN -C KPDS(1) AND NO GDS SENT. -C -C 7 - EDITION INDICATED IN KPDS(18) HAS NOT -C YET BEEN INCLUDED IN THE DECODER. -C -C 8 - GRID IDENTIFICATION = 255 (NOT STANDARD -C GRID) BUT FLAG INDICATING PRESENCE OF -C GDS IS TURNED OFF. NO METHOD OF -C GENERATING PROPER GRID. -C -C 9 - PRODUCT OF KGDS(2) AND KGDS(3) DOES NOT -C MATCH STANDARD NUMBER OF POINTS FOR THIS -C GRID (FOR OTHER THAN SPECTRALS). THIS -C WILL OCCUR ONLY IF THE GRID. -C IDENTIFICATION, KPDS(3), AND A -C TRANSMITTED GDS ARE INCONSISTENT. -C -C 10 - CENTER INDICATOR WAS NOT ONE INDICATED -C IN "GRIB" TABLE 1. PLEASE CONTACT AD -C PRODUCTION MANAGEMENT BRANCH (W/NMC42) -C IF THIS ERROR IS ENCOUNTERED. -C -C 11 - BINARY DATA SECTION (BDS) NOT COMPLETELY -C PROCESSED. PROGRAM IS NOT SET TO PROCESS -C FLAG COMBINATIONS AS SHOWN IN -C OCTETS 4 AND 14. -C -C -C LIST OF TEXT MESSAGES FROM CODE -C -C -C W3FI63/FI632 -C -C 'HAVE ENCOUNTERED A NEW GRID FOR NMC, PLEASE NOTIFY -C AUTOMATION DIVISION, PRODUCTION MANAGEMENT BRANCH -C (W/NMC42)' -C -C 'HAVE ENCOUNTERED A NEW GRID FOR ECMWF, PLEASE NOTIFY -C AUTOMATION DIVISION, PRODUCTION MANAGEMENT BRANCH -C (W/NMC42)' -C -C 'HAVE ENCOUNTERED A NEW GRID FOR U.K. METEOROLOGICAL -C OFFICE, BRACKNELL. PLEASE NOTIFY AUTOMATION DIVISION, -C PRODUCTION MANAGEMENT BRANCH (W/NMC42)' -C -C 'HAVE ENCOUNTERED A NEW GRID FOR FNOC, PLEASE NOTIFY -C AUTOMATION DIVISION, PRODUCTION MANAGEMENT BRANCH -C (W/NMC42)' -C -C -C W3FI63/FI633 -C -C 'POLAR STEREO PROCESSING NOT AVAILABLE' * -C -C W3FI63/FI634 -C -C 'WARNING - BIT MAP MAY NOT BE ASSOCIATED WITH SPHERICAL -C COEFFICIENTS' -C -C -C W3FI63/FI637 -C -C 'NO CURRENT LISTING OF FNOC GRIDS' * -C -C -C * WILL BE AVAILABLE IN NEXT UPDATE -C *************************************************************** - - - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: GETGB FINDS AND UNPACKS A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. -C READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF) -C TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE. -C (THE INDEX BUFFER IS SAVED FOR USE BY FUTURE PROSPECTIVE CALLS.) -C FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB MESSAGE REQUESTED. -C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP -C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER -C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) -C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE -C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH -C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), -C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE -C RETURN CODE WILL BE NONZERO. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS -C AND ALLOWED FOR UNSPECIFIED INDEX FILE -C -C USAGE: CALL GETGB(LUGB,LUGI,JF,J,JPDS,JGDS, -C & KF,K,KPDS,KGDS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE -C (=0 TO GET INDEX BUFFER FROM THE GRIB FILE) -C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK -C J INTEGER NUMBER OF MESSAGES TO SKIP -C (=0 TO SEARCH FROM BEGINNING) -C (<0 TO READ INDEX BUFFER AND SKIP -1-J MESSAGES) -C JPDS INTEGER (200) PDS PARAMETERS FOR WHICH TO SEARCH -C (=-1 FOR WILDCARD) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C JGDS INTEGER (200) GDS PARAMETERS FOR WHICH TO SEARCH -C (ONLY SEARCHED IF JPDS(3)=255) -C (=-1 FOR WILDCARD) -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C OUTPUT ARGUMENTS: -C KF INTEGER NUMBER OF DATA POINTS UNPACKED -C K INTEGER MESSAGE NUMBER UNPACKED -C (CAN BE SAME AS J IN CALLING PROGRAM -C IN ORDER TO FACILITATE MULTIPLE SEARCHES) -C KPDS INTEGER (200) UNPACKED PDS PARAMETERS -C KGDS INTEGER (200) UNPACKED GDS PARAMETERS -C LB LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT -C F REAL (KF) UNPACKED DATA -C IRET INTEGER RETURN CODE -C 0 ALL OK -C 96 ERROR READING INDEX FILE -C 97 ERROR READING GRIB FILE -C 98 NUMBER OF DATA POINTS GREATER THAN JF -C 99 REQUEST NOT FOUND -C OTHER W3FI63 GRIB UNPACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C GETGBM FIND AND UNPACK GRIB MESSAGE -C -C REMARKS: IN ORDER TO UNPACK GRIB FROM A MULTIPROCESSING ENVIRONMENT -C WHERE EACH PROCESSOR IS ATTEMPTING TO READ FROM ITS OWN PAIR OF -C LOGICAL UNITS, ONE MUST DIRECTLY CALL SUBPROGRAM GETGBM AS BELOW, -C ALLOCATING A PRIVATE COPY OF CBUF, NLEN AND NNUM TO EACH PROCESSOR. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - - - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BAOPEN BYTE-ADDRESSABLE OPEN -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BAOPEN(LU,CFN,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO OPEN -C CFN CHARACTER FILENAME TO OPEN -C (CONSISTING OF NONBLANK PRINTABLE CHARACTERS) -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ - - -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: BACLOSE BYTE-ADDRESSABLE CLOSE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1998-06-04 -C -C ABSTRACT: CLOSE A BYTE-ADDRESSABLE FILE. -C -C PROGRAM HISTORY LOG: -C 1998-06-04 IREDELL -C -C USAGE: CALL BACLOSE(LU,IRET) -C INPUT ARGUMENTS: -C LU INTEGER UNIT TO CLOSE -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C -C MODULES USED: -C BACIO_MODULE BYTE-ADDRESSABLE I/O FORTRAN INTERFACE -C -C SUBPROGRAMS CALLED: -C BACIO BYTE-ADDRESSABLE I/O C PACKAGE -C -C REMARKS: A BAOPEN MUST HAVE ALREADY BEEN CALLED. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/idsdef.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/idsdef.f deleted file mode 100755 index ca8862c9ac..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/idsdef.f +++ /dev/null @@ -1,285 +0,0 @@ - SUBROUTINE IDSDEF(IPTV,IDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: IDSDEF SETS DEFAULT DECIMAL SCALINGS -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 92-10-31 -C -C ABSTRACT: SETS DECIMAL SCALINGS DEFAULTS FOR VARIOUS PARAMETERS. -C A DECIMAL SCALING OF -3 MEANS DATA IS PACKED IN KILO-SI UNITS. -C -C PROGRAM HISTORY LOG: -C 92-10-31 IREDELL -C -C USAGE: CALL IDSDEF(IPTV,IDS) -C INPUT ARGUMENTS: -C IPTV PARAMTER TABLE VERSION (ONLY 1 OR 2 IS RECOGNIZED) -C OUTPUT ARGUMENTS: -C IDS INTEGER (255) DECIMAL SCALINGS -C (UNKNOWN DECIMAL SCALINGS WILL NOT BE SET) -C -C ATTRIBUTES: -C LANGUAGE: CRAY FORTRAN -C -C$$$ - DIMENSION IDS(255) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(IPTV.EQ.1.OR.IPTV.EQ.2) THEN - IDS(001)=-1 ! PRESSURE (PA) - IDS(002)=-1 ! SEA-LEVEL PRESSURE (PA) - IDS(003)=3 ! PRESSURE TENDENCY (PA/S) - ! - ! - IDS(006)=-1 ! GEOPOTENTIAL (M2/S2) - IDS(007)=0 ! GEOPOTENTIAL HEIGHT (M) - IDS(008)=0 ! GEOMETRIC HEIGHT (M) - IDS(009)=0 ! STANDARD DEVIATION OF HEIGHT (M) - ! - IDS(011)=1 ! TEMPERATURE (K) - IDS(012)=1 ! VIRTUAL TEMPERATURE (K) - IDS(013)=1 ! POTENTIAL TEMPERATURE (K) - IDS(014)=1 ! PSEUDO-ADIABATIC POTENTIAL TEMPERATURE (K) - IDS(015)=1 ! MAXIMUM TEMPERATURE (K) - IDS(016)=1 ! MINIMUM TEMPERATURE (K) - IDS(017)=1 ! DEWPOINT TEMPERATURE (K) - IDS(018)=1 ! DEWPOINT DEPRESSION (K) - IDS(019)=4 ! TEMPERATURE LAPSE RATE (K/M) - IDS(020)=0 ! VISIBILITY (M) - ! RADAR SPECTRA 1 () - ! RADAR SPECTRA 2 () - ! RADAR SPECTRA 3 () - ! - IDS(025)=1 ! TEMPERATURE ANOMALY (K) - IDS(026)=-1 ! PRESSURE ANOMALY (PA) - IDS(027)=0 ! GEOPOTENTIAL HEIGHT ANOMALY (M) - ! WAVE SPECTRA 1 () - ! WAVE SPECTRA 2 () - ! WAVE SPECTRA 3 () - IDS(031)=0 ! WIND DIRECTION (DEGREES) - IDS(032)=1 ! WIND SPEED (M/S) - IDS(033)=1 ! ZONAL WIND (M/S) - IDS(034)=1 ! MERIDIONAL WIND (M/S) - IDS(035)=-4 ! STREAMFUNCTION (M2/S) - IDS(036)=-4 ! VELOCITY POTENTIAL (M2/S) - IDS(037)=-1 ! MONTGOMERY STREAM FUNCTION (M2/S2) - IDS(038)=8 ! SIGMA VERTICAL VELOCITY (1/S) - IDS(039)=3 ! PRESSURE VERTICAL VELOCITY (PA/S) - IDS(040)=4 ! GEOMETRIC VERTICAL VELOCITY (M/S) - IDS(041)=6 ! ABSOLUTE VORTICITY (1/S) - IDS(042)=6 ! ABSOLUTE DIVERGENCE (1/S) - IDS(043)=6 ! RELATIVE VORTICITY (1/S) - IDS(044)=6 ! RELATIVE DIVERGENCE (1/S) - IDS(045)=4 ! VERTICAL U SHEAR (1/S) - IDS(046)=4 ! VERTICAL V SHEAR (1/S) - IDS(047)=0 ! DIRECTION OF CURRENT (DEGREES) - ! SPEED OF CURRENT (M/S) - ! U OF CURRENT (M/S) - ! V OF CURRENT (M/S) - IDS(051)=4 ! SPECIFIC HUMIDITY (KG/KG) - IDS(052)=0 ! RELATIVE HUMIDITY (PERCENT) - IDS(053)=4 ! HUMIDITY MIXING RATIO (KG/KG) - IDS(054)=1 ! PRECIPITABLE WATER (KG/M2) - IDS(055)=-1 ! VAPOR PRESSURE (PA) - IDS(056)=-1 ! SATURATION DEFICIT (PA) - IDS(057)=1 ! EVAPORATION (KG/M2) - IDS(058)=1 ! CLOUD ICE (KG/M2) - IDS(059)=6 ! PRECIPITATION RATE (KG/M2/S) - IDS(060)=0 ! THUNDERSTORM PROBABILITY (PERCENT) - IDS(061)=1 ! TOTAL PRECIPITATION (KG/M2) - IDS(062)=1 ! LARGE-SCALE PRECIPITATION (KG/M2) - IDS(063)=1 ! CONVECTIVE PRECIPITATION (KG/M2) - IDS(064)=6 ! WATER EQUIVALENT SNOWFALL RATE (KG/M2/S) - IDS(065)=0 ! WATER EQUIVALENT OF SNOW DEPTH (KG/M2) - IDS(066)=2 ! SNOW DEPTH (M) - ! MIXED-LAYER DEPTH (M) - ! TRANSIENT THERMOCLINE DEPTH (M) - ! MAIN THERMOCLINE DEPTH (M) - ! MAIN THERMOCLINE ANOMALY (M) - IDS(071)=0 ! TOTAL CLOUD COVER (PERCENT) - IDS(072)=0 ! CONVECTIVE CLOUD COVER (PERCENT) - IDS(073)=0 ! LOW CLOUD COVER (PERCENT) - IDS(074)=0 ! MIDDLE CLOUD COVER (PERCENT) - IDS(075)=0 ! HIGH CLOUD COVER (PERCENT) - IDS(076)=1 ! CLOUD WATER (KG/M2) - ! - IDS(078)=1 ! CONVECTIVE SNOW (KG/M2) - IDS(079)=1 ! LARGE SCALE SNOW (KG/M2) - IDS(080)=1 ! WATER TEMPERATURE (K) - IDS(081)=0 ! SEA-LAND MASK () - ! DEVIATION OF SEA LEVEL FROM MEAN (M) - IDS(083)=5 ! ROUGHNESS (M) - IDS(084)=1 ! ALBEDO (PERCENT) - IDS(085)=1 ! SOIL TEMPERATURE (K) - IDS(086)=0 ! SOIL WETNESS (KG/M2) - IDS(087)=0 ! VEGETATION (PERCENT) - ! SALINITY (KG/KG) - IDS(089)=4 ! DENSITY (KG/M3) - IDS(090)=1 ! RUNOFF (KG/M2) - IDS(091)=0 ! ICE CONCENTRATION () - ! ICE THICKNESS (M) - IDS(093)=0 ! DIRECTION OF ICE DRIFT (DEGREES) - ! SPEED OF ICE DRIFT (M/S) - ! U OF ICE DRIFT (M/S) - ! V OF ICE DRIFT (M/S) - ! ICE GROWTH (M) - ! ICE DIVERGENCE (1/S) - IDS(099)=1 ! SNOW MELT (KG/M2) - ! SIG HEIGHT OF WAVES AND SWELL (M) - IDS(101)=0 ! DIRECTION OF WIND WAVES (DEGREES) - ! SIG HEIGHT OF WIND WAVES (M) - ! MEAN PERIOD OF WIND WAVES (S) - IDS(104)=0 ! DIRECTION OF SWELL WAVES (DEGREES) - ! SIG HEIGHT OF SWELL WAVES (M) - ! MEAN PERIOD OF SWELL WAVES (S) - IDS(107)=0 ! PRIMARY WAVE DIRECTION (DEGREES) - ! PRIMARY WAVE MEAN PERIOD (S) - IDS(109)=0 ! SECONDARY WAVE DIRECTION (DEGREES) - ! SECONDARY WAVE MEAN PERIOD (S) - IDS(111)=0 ! NET SOLAR RADIATIVE FLUX AT SURFACE (W/M2) - IDS(112)=0 ! NET LONGWAVE RADIATIVE FLUX AT SURFACE (W/M2) - IDS(113)=0 ! NET SOLAR RADIATIVE FLUX AT TOP (W/M2) - IDS(114)=0 ! NET LONGWAVE RADIATIVE FLUX AT TOP (W/M2) - IDS(115)=0 ! NET LONGWAVE RADIATIVE FLUX (W/M2) - IDS(116)=0 ! NET SOLAR RADIATIVE FLUX (W/M2) - IDS(117)=0 ! TOTAL RADIATIVE FLUX (W/M2) - ! - ! - ! - IDS(121)=0 ! LATENT HEAT FLUX (W/M2) - IDS(122)=0 ! SENSIBLE HEAT FLUX (W/M2) - IDS(123)=0 ! BOUNDARY LAYER DISSIPATION (W/M2) - IDS(124)=3 ! U WIND STRESS (N/M2) - IDS(125)=3 ! V WIND STRESS (N/M2) - ! WIND MIXING ENERGY (J) - ! IMAGE DATA () - IDS(128)=-1 ! MEAN SEA-LEVEL PRESSURE (STDATM) (PA) - IDS(129)=-1 ! MEAN SEA-LEVEL PRESSURE (MAPS) (PA) - IDS(130)=-1 ! MEAN SEA-LEVEL PRESSURE (ETA) (PA) - IDS(131)=1 ! SURFACE LIFTED INDEX (K) - IDS(132)=1 ! BEST LIFTED INDEX (K) - IDS(133)=1 ! K INDEX (K) - IDS(134)=1 ! SWEAT INDEX (K) - IDS(135)=10 ! HORIZONTAL MOISTURE DIVERGENCE (KG/KG/S) - IDS(136)=4 ! SPEED SHEAR (1/S) - IDS(137)=3 ! 3-HR PRESSURE TENDENCY (PA/S) - IDS(138)=6 ! BRUNT-VAISALA FREQUENCY SQUARED (1/S2) - IDS(139)=11 ! POTENTIAL VORTICITY (MASS-WEIGHTED) (1/S/M) - IDS(140)=0 ! RAIN MASK () - IDS(141)=0 ! FREEZING RAIN MASK () - IDS(142)=0 ! ICE PELLETS MASK () - IDS(143)=0 ! SNOW MASK () - IDS(144)=3 ! VOLUMETRIC SOIL MOISTURE CONTENT (FRACTION) - IDS(145)=0 ! POTENTIAL EVAPORATION RATE (W/M2) - IDS(146)=0 ! CLOUD WORKFUNCTION (J/KG) - IDS(147)=3 ! U GRAVITY WAVE STRESS (N/M2) - IDS(148)=3 ! V GRAVITY WAVE STRESS (N/M2) - IDS(149)=10 ! POTENTIAL VORTICITY (M2/S/KG) - ! COVARIANCE BETWEEN V AND U (M2/S2) - ! COVARIANCE BETWEEN U AND T (K*M/S) - ! COVARIANCE BETWEEN V AND T (K*M/S) - ! - ! - IDS(155)=0 ! GROUND HEAT FLUX (W/M2) - IDS(156)=0 ! CONVECTIVE INHIBITION (W/M2) - IDS(157)=0 ! CONVECTIVE APE (J/KG) - IDS(158)=0 ! TURBULENT KE (J/KG) - IDS(159)=-1 ! CONDENSATION PRESSURE OF LIFTED PARCEL (PA) - IDS(160)=0 ! CLEAR SKY UPWARD SOLAR FLUX (W/M2) - IDS(161)=0 ! CLEAR SKY DOWNWARD SOLAR FLUX (W/M2) - IDS(162)=0 ! CLEAR SKY UPWARD LONGWAVE FLUX (W/M2) - IDS(163)=0 ! CLEAR SKY DOWNWARD LONGWAVE FLUX (W/M2) - IDS(164)=0 ! CLOUD FORCING NET SOLAR FLUX (W/M2) - IDS(165)=0 ! CLOUD FORCING NET LONGWAVE FLUX (W/M2) - IDS(166)=0 ! VISIBLE BEAM DOWNWARD SOLAR FLUX (W/M2) - IDS(167)=0 ! VISIBLE DIFFUSE DOWNWARD SOLAR FLUX (W/M2) - IDS(168)=0 ! NEAR IR BEAM DOWNWARD SOLAR FLUX (W/M2) - IDS(169)=0 ! NEAR IR DIFFUSE DOWNWARD SOLAR FLUX (W/M2) - ! - ! - IDS(172)=3 ! MOMENTUM FLUX (N/M2) - IDS(173)=0 ! MASS POINT MODEL SURFACE () - IDS(174)=0 ! VELOCITY POINT MODEL SURFACE () - IDS(175)=0 ! SIGMA LAYER NUMBER () - IDS(176)=2 ! LATITUDE (DEGREES) - IDS(177)=2 ! EAST LONGITUDE (DEGREES) - ! - ! - ! - IDS(181)=9 ! X-GRADIENT LOG PRESSURE (1/M) - IDS(182)=9 ! Y-GRADIENT LOG PRESSURE (1/M) - IDS(183)=5 ! X-GRADIENT HEIGHT (M/M) - IDS(184)=5 ! Y-GRADIENT HEIGHT (M/M) - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - ! - IDS(201)=0 ! ICE-FREE WATER SURCACE (PERCENT) - ! - ! - IDS(204)=0 ! DOWNWARD SOLAR RADIATIVE FLUX (W/M2) - IDS(205)=0 ! DOWNWARD LONGWAVE RADIATIVE FLUX (W/M2) - ! - IDS(207)=0 ! MOISTURE AVAILABILITY (PERCENT) - ! EXCHANGE COEFFICIENT (KG/M2/S) - IDS(209)=0 ! NUMBER OF MIXED LAYER NEXT TO SFC () - ! - IDS(211)=0 ! UPWARD SOLAR RADIATIVE FLUX (W/M2) - IDS(212)=0 ! UPWARD LONGWAVE RADIATIVE FLUX (W/M2) - IDS(213)=0 ! NON-CONVECTIVE CLOUD COVER (PERCENT) - IDS(214)=6 ! CONVECTIVE PRECIPITATION RATE (KG/M2/S) - IDS(215)=7 ! TOTAL DIABATIC HEATING RATE (K/S) - IDS(216)=7 ! TOTAL RADIATIVE HEATING RATE (K/S) - IDS(217)=7 ! TOTAL DIABATIC NONRADIATIVE HEATING RATE (K/S) - IDS(218)=2 ! PRECIPITATION INDEX (FRACTION) - IDS(219)=1 ! STD DEV OF IR T OVER 1X1 DEG AREA (K) - IDS(220)=4 ! NATURAL LOG OF SURFACE PRESSURE OVER 1 KPA () - ! - IDS(222)=0 ! 5-WAVE GEOPOTENTIAL HEIGHT (M) - IDS(223)=1 ! PLANT CANOPY SURFACE WATER (KG/M2) - ! - ! - ! BLACKADARS MIXING LENGTH (M) - ! ASYMPTOTIC MIXING LENGTH (M) - IDS(228)=1 ! POTENTIAL EVAPORATION (KG/M2) - IDS(229)=0 ! SNOW PHASE-CHANGE HEAT FLUX (W/M2) - ! - IDS(231)=3 ! CONVECTIVE CLOUD MASS FLUX (PA/S) - IDS(232)=0 ! DOWNWARD TOTAL RADIATION FLUX (W/M2) - IDS(233)=0 ! UPWARD TOTAL RADIATION FLUX (W/M2) - IDS(224)=1 ! BASEFLOW-GROUNDWATER RUNOFF (KG/M2) - IDS(225)=1 ! STORM SURFACE RUNOFF (KG/M2) - ! - ! - IDS(238)=0 ! SNOW COVER (PERCENT) - IDS(239)=1 ! SNOW TEMPERATURE (K) - ! - IDS(241)=7 ! LARGE SCALE CONDENSATION HEATING RATE (K/S) - IDS(242)=7 ! DEEP CONVECTIVE HEATING RATE (K/S) - IDS(243)=10 ! DEEP CONVECTIVE MOISTENING RATE (KG/KG/S) - IDS(244)=7 ! SHALLOW CONVECTIVE HEATING RATE (K/S) - IDS(245)=10 ! SHALLOW CONVECTIVE MOISTENING RATE (KG/KG/S) - IDS(246)=7 ! VERTICAL DIFFUSION HEATING RATE (KG/KG/S) - IDS(247)=7 ! VERTICAL DIFFUSION ZONAL ACCELERATION (M/S/S) - IDS(248)=7 ! VERTICAL DIFFUSION MERID ACCELERATION (M/S/S) - IDS(249)=10 ! VERTICAL DIFFUSION MOISTENING RATE (KG/KG/S) - IDS(250)=7 ! SOLAR RADIATIVE HEATING RATE (K/S) - IDS(251)=7 ! LONGWAVE RADIATIVE HEATING RATE (K/S) - ! DRAG COEFFICIENT () - ! FRICTION VELOCITY (M/S) - ! RICHARDSON NUMBER () - ! - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/instrument.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/instrument.f deleted file mode 100755 index 0c936f9946..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/instrument.f +++ /dev/null @@ -1,111 +0,0 @@ -!----------------------------------------------------------------------- - SUBROUTINE INSTRUMENT(K,KALL,TTOT,TMIN,TMAX) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! . . . . -! SUBPROGRAM: INSTRUMENT MONITOR WALL-CLOCK TIMES, ETC. -! PRGMMR: IREDELL ORG: NP23 DATE:1998-07-16 -! -! ABSTRACT: THIS SUBPROGRAM IS USEFUL IN INSTRUMENTING A CODE -! BY MONITORING THE NUMBER OF TIMES EACH GIVEN SECTION -! OF A PROGRAM IS INVOKED AS WELL AS THE MINIMUM, MAXIMUM -! AND TOTAL WALL-CLOCK TIME SPENT IN THE GIVEN SECTION. -! -! PROGRAM HISTORY LOG: -! 1998-07-16 IREDELL -! -! USAGE: CALL INSTRUMENT(K,KALL,TTOT,TMIN,TMAX) -! INPUT ARGUMENT LIST: -! K - INTEGER POSITIVE SECTION NUMBER -! OR MAXIMUM SECTION NUMBER IN THE FIRST INVOCATION -! OR ZERO TO RESET ALL WALL-CLOCK STATISTICS -! OR NEGATIVE SECTION NUMBER TO SKIP MONITORING -! AND JUST RETURN STATISTICS. -! -! OUTPUT ARGUMENT LIST: -! KALL - INTEGER NUMBER OF TIMES SECTION IS CALLED -! TTOT - REAL TOTAL SECONDS SPENT IN SECTION -! TMIN - REAL MINIMUM SECONDS SPENT IN SECTION -! TMAX - REAL MAXIMUM SECONDS SPENT IN SECTION -! -! SUBPROGRAMS CALLED: -! W3UTCDAT RETURN THE UTC DATE AND TIME -! W3DIFDAT RETURN A TIME INTERVAL BETWEEN TWO DATES -! -! REMARKS: -! THIS SUBPROGRAM SHOULD NOT BE INVOKED FROM A MULTITASKING REGION. -! NORMALLY, TIME SPENT INSIDE THIS SUBPROGRAM IS NOT COUNTED. -! WALL-CLOCK TIMES ARE KEPT TO THE NEAREST MILLISECOND. -! -! EXAMPLE. -! CALL INSTRUMENT(2,KALL,TTOT,TMIN,TMAX) ! KEEP STATS FOR 2 SUBS -! DO K=1,N -! CALL SUB1 -! CALL INSTRUMENT(1,KALL,TTOT,TMIN,TMAX) ! ACCUM STATS FOR SUB1 -! CALL SUB2 -! CALL INSTRUMENT(2,KALL,TTOT,TMIN,TMAX) ! ACCUM STATS FOR SUB2 -! ENDDO -! PRINT *,'SUB2 STATS: ',KALL,TTOT,TMIN,TMAX -! CALL INSTRUMENT(-1,KALL,TTOT,TMIN,TMAX) ! RETURN STATS FOR SUB1 -! PRINT *,'SUB1 STATS: ',KALL,TTOT,TMIN,TMAX -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - IMPLICIT NONE - INTEGER,INTENT(IN):: K - INTEGER,INTENT(OUT):: KALL - REAL,INTENT(OUT):: TTOT,TMIN,TMAX - INTEGER,SAVE:: KMAX=0 - INTEGER,DIMENSION(:),ALLOCATABLE,SAVE:: KALLS - REAL,DIMENSION(:),ALLOCATABLE,SAVE:: TTOTS,TMINS,TMAXS - INTEGER,DIMENSION(8),SAVE:: IDAT - INTEGER,DIMENSION(8):: JDAT - REAL,DIMENSION(5):: RINC - INTEGER:: KA -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - KA=ABS(K) -! ALLOCATE MONITORING ARRAYS IF INITIAL INVOCATION - IF(KMAX.EQ.0) THEN - KMAX=K - ALLOCATE(KALLS(KMAX)) - ALLOCATE(TTOTS(KMAX)) - ALLOCATE(TMINS(KMAX)) - ALLOCATE(TMAXS(KMAX)) - KALLS=0 - KA=0 -! OR RESET ALL STATISTICS BACK TO ZERO - ELSEIF(K.EQ.0) THEN - KALLS=0 -! OR COUNT TIME SINCE LAST INVOCATION AGAINST THIS SECTION - ELSEIF(K.GT.0) THEN - CALL W3UTCDAT(JDAT) - CALL W3DIFDAT(JDAT,IDAT,4,RINC) - KALLS(K)=KALLS(K)+1 - IF(KALLS(K).EQ.1) THEN - TTOTS(K)=RINC(4) - TMINS(K)=RINC(4) - TMAXS(K)=RINC(4) - ELSE - TTOTS(K)=TTOTS(K)+RINC(4) - TMINS(K)=MIN(TMINS(K),RINC(4)) - TMAXS(K)=MAX(TMAXS(K),RINC(4)) - ENDIF - ENDIF -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! RETURN STATISTICS - IF(KA.GE.1.AND.KA.LE.KMAX.AND.KALLS(KA).GT.0) THEN - KALL=KALLS(KA) - TTOT=TTOTS(KA) - TMIN=TMINS(KA) - TMAX=TMAXS(KA) - ELSE - KALL=0 - TTOT=0 - TMIN=0 - TMAX=0 - ENDIF -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! KEEP CURRENT TIME FOR NEXT INVOCATION - IF(K.GE.0) CALL W3UTCDAT(IDAT) - END SUBROUTINE INSTRUMENT diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/iw3jdn.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/iw3jdn.f deleted file mode 100755 index 896d62114b..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/iw3jdn.f +++ /dev/null @@ -1,62 +0,0 @@ - FUNCTION IW3JDN(IYEAR,MONTH,IDAY) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: IW3JDN COMPUTE JULIAN DAY NUMBER -C AUTHOR: JONES,R.E. ORG: W342 DATE: 87-03-29 -C -C ABSTRACT: COMPUTES JULIAN DAY NUMBER FROM YEAR (4 DIGITS), MONTH, -C AND DAY. IW3JDN IS VALID FOR YEARS 1583 A.D. TO 3300 A.D. -C JULIAN DAY NUMBER CAN BE USED TO COMPUTE DAY OF WEEK, DAY OF -C YEAR, RECORD NUMBERS IN AN ARCHIVE, REPLACE DAY OF CENTURY, -C FIND THE NUMBER OF DAYS BETWEEN TWO DATES. -C -C PROGRAM HISTORY LOG: -C 87-03-29 R.E.JONES -C 89-10-25 R.E.JONES CONVERT TO CRAY CFT77 FORTRAN -C -C USAGE: II = IW3JDN(IYEAR,MONTH,IDAY) -C -C INPUT VARIABLES: -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C ------ --------- ----------------------------------------------- -C IYEAR ARG LIST INTEGER YEAR ( 4 DIGITS) -C MONTH ARG LIST INTEGER MONTH OF YEAR (1 - 12) -C IDAY ARG LIST INTEGER DAY OF MONTH (1 - 31) -C -C OUTPUT VARIABLES: -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C ------ --------- ----------------------------------------------- -C IW3JDN FUNTION INTEGER JULIAN DAY NUMBER -C JAN. 1,1960 IS JULIAN DAY NUMBER 2436935 -C JAN. 1,1987 IS JULIAN DAY NUMBER 2446797 -C -C REMARKS: JULIAN PERIOD WAS DEVISED BY JOSEPH SCALIGER IN 1582. -C JULIAN DAY NUMBER #1 STARTED ON JAN. 1,4713 B.C. THREE MAJOR -C CHRONOLOGICAL CYCLES BEGIN ON THE SAME DAY. A 28-YEAR SOLAR -C CYCLE, A 19-YEAR LUNER CYCLE, A 15-YEAR INDICTION CYCLE, USED -C IN ANCIENT ROME TO REGULATE TAXES. IT WILL TAKE 7980 YEARS -C TO COMPLETE THE PERIOD, THE PRODUCT OF 28, 19, AND 15. -C SCALIGER NAMED THE PERIOD, DATE, AND NUMBER AFTER HIS FATHER -C JULIUS (NOT AFTER THE JULIAN CALENDAR). THIS SEEMS TO HAVE -C CAUSED A LOT OF CONFUSION IN TEXT BOOKS. SCALIGER NAME IS -C SPELLED THREE DIFFERENT WAYS. JULIAN DATE AND JULIAN DAY -C NUMBER ARE INTERCHANGED. A JULIAN DATE IS USED BY ASTRONOMERS -C TO COMPUTE ACCURATE TIME, IT HAS A FRACTION. WHEN TRUNCATED TO -C AN INTEGER IT IS CALLED AN JULIAN DAY NUMBER. THIS FUNCTION -C WAS IN A LETTER TO THE EDITOR OF THE COMMUNICATIONS OF THE ACM -C VOLUME 11 / NUMBER 10 / OCTOBER 1968. THE JULIAN DAY NUMBER -C CAN BE CONVERTED TO A YEAR, MONTH, DAY, DAY OF WEEK, DAY OF -C YEAR BY CALLING SUBROUTINE W3FS26. -C -C ATTRIBUTES: -C LANGUAGE: CRAY CFT77 FORTRAN -C MACHINE: CRAY Y-MP8/864, CRAY Y-MP EL2/256 -C -C$$$ -C - IW3JDN = IDAY - 32075 - & + 1461 * (IYEAR + 4800 + (MONTH - 14) / 12) / 4 - & + 367 * (MONTH - 2 - (MONTH -14) / 12 * 12) / 12 - & - 3 * ((IYEAR + 4900 + (MONTH - 14) / 12) / 100) / 4 - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/ixgb.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/ixgb.f deleted file mode 100755 index 0645a3f936..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/ixgb.f +++ /dev/null @@ -1,155 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE IXGB(LUGB,LSKIP,LGRIB,NLEN,NNUM,MLEN,CBUF) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: IXGB MAKE INDEX RECORD -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 -C -C ABSTRACT: THIS SUBPROGRAM MAKES ONE INDEX RECORD. -C BYTE 001-004: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE -C BYTE 005-008: BYTES TO SKIP IN MESSAGE BEFORE PDS -C BYTE 009-012: BYTES TO SKIP IN MESSAGE BEFORE GDS (0 IF NO GDS) -C BYTE 013-016: BYTES TO SKIP IN MESSAGE BEFORE BMS (0 IF NO BMS) -C BYTE 017-020: BYTES TO SKIP IN MESSAGE BEFORE BDS -C BYTE 021-024: BYTES TOTAL IN THE MESSAGE -C BYTE 025-025: GRIB VERSION NUMBER -C BYTE 026-053: PRODUCT DEFINITION SECTION (PDS) -C BYTE 054-095: GRID DEFINITION SECTION (GDS) (OR NULLS) -C BYTE 096-101: FIRST PART OF THE BIT MAP SECTION (BMS) (OR NULLS) -C BYTE 102-112: FIRST PART OF THE BINARY DATA SECTION (BDS) -C BYTE 113-172: (OPTIONAL) BYTES 41-100 OF THE PDS -C BYTE 173-184: (OPTIONAL) BYTES 29-40 OF THE PDS -C BYTE 185-320: (OPTIONAL) BYTES 43-178 OF THE GDS -C -C PROGRAM HISTORY LOG: -C 95-10-31 IREDELL -C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 -C 2001-06-05 IREDELL APPLY LINUX PORT BY EBISUZAKI -C -C USAGE: CALL WRGI1R(LUGB,LSKIP,LGRIB,LUGI) -C INPUT ARGUMENTS: -C LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE -C LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE -C LGRIB INTEGER NUMBER OF BYTES IN GRIB MESSAGE -C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES -C NNUM INTEGER INDEX RECORD NUMBER TO MAKE -C OUTPUT ARGUMENTS: -C MLEN INTEGER ACTUAL VALID LENGTH OF INDEX RECORD -C CBUF CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA -C -C SUBPROGRAMS CALLED: -C GBYTEC GET INTEGER DATA FROM BYTES -C SBYTEC STORE INTEGER DATA IN BYTES -C BAREAD BYTE-ADDRESSABLE READ -C -C ATTRIBUTES: -C LANGUAGE: CRAY FORTRAN -C -C$$$ - CHARACTER CBUF(*) - PARAMETER(LINDEX=112,MINDEX=320) - PARAMETER(IXSKP=0,IXSPD=4,IXSGD=8,IXSBM=12,IXSBD=16,IXLEN=20, - & IXVER=24,IXPDS=25,IXGDS=53,IXBMS=95,IXBDS=101, - & IXPDX=112,IXPDW=172,IXGDX=184) - PARAMETER(MXSKP=4,MXSPD=4,MXSGD=4,MXSBM=4,MXSBD=4,MXLEN=4, - & MXVER=1,MXPDS=28,MXGDS=42,MXBMS=6,MXBDS=11, - & MXPDX=60,MXPDW=12,MXGDX=136) - CHARACTER CBREAD(MINDEX),CINDEX(MINDEX) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C INITIALIZE INDEX RECORD AND READ GRIB MESSAGE - MLEN=LINDEX - CINDEX=CHAR(0) - CALL SBYTEC(CINDEX,LSKIP,8*IXSKP,8*MXSKP) - CALL SBYTEC(CINDEX,LGRIB,8*IXLEN,8*MXLEN) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PUT PDS IN INDEX RECORD - ISKPDS=8 - IBSKIP=LSKIP - IBREAD=ISKPDS+MXPDS - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CINDEX(IXVER+1)=CBREAD(8) - CALL SBYTEC(CINDEX,ISKPDS,8*IXSPD,8*MXSPD) - CALL GBYTEC(CBREAD,LENPDS,8*ISKPDS,8*3) - CALL GBYTEC(CBREAD,INCGDS,8*ISKPDS+8*7+0,1) - CALL GBYTEC(CBREAD,INCBMS,8*ISKPDS+8*7+1,1) - ILNPDS=MIN(LENPDS,MXPDS) - CINDEX(IXPDS+1:IXPDS+ILNPDS)=CBREAD(ISKPDS+1:ISKPDS+ILNPDS) - ISKTOT=ISKPDS+LENPDS -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PUT PDS EXTENSION IN INDEX RECORD - IF(LENPDS.GT.MXPDS) THEN - ISKPDW=ISKPDS+MXPDS - ILNPDW=MIN(LENPDS-MXPDS,MXPDW) - IBSKIP=LSKIP+ISKPDW - IBREAD=ILNPDW - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CINDEX(IXPDW+1:IXPDW+ILNPDW)=CBREAD(1:ILNPDW) - ISKPDX=ISKPDS+(MXPDS+MXPDW) - ILNPDX=MIN(LENPDS-(MXPDS+MXPDW),MXPDX) - IBSKIP=LSKIP+ISKPDX - IBREAD=ILNPDX - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CINDEX(IXPDX+1:IXPDX+ILNPDX)=CBREAD(1:ILNPDX) - MLEN=MAX(MLEN,IXPDW+ILNPDW,IXPDX+ILNPDX) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PUT GDS IN INDEX RECORD - IF(INCGDS.NE.0) THEN - ISKGDS=ISKTOT - IBSKIP=LSKIP+ISKGDS - IBREAD=MXGDS - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CALL SBYTEC(CINDEX,ISKGDS,8*IXSGD,8*MXSGD) - CALL GBYTEC(CBREAD,LENGDS,0,8*3) - ILNGDS=MIN(LENGDS,MXGDS) - CINDEX(IXGDS+1:IXGDS+ILNGDS)=CBREAD(1:ILNGDS) - ISKTOT=ISKGDS+LENGDS - IF(LENGDS.GT.MXGDS) THEN - ISKGDX=ISKGDS+MXGDS - ILNGDX=MIN(LENGDS-MXGDS,MXGDX) - IBSKIP=LSKIP+ISKGDX - IBREAD=ILNGDX - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CINDEX(IXGDX+1:IXGDX+ILNGDX)=CBREAD(1:ILNGDX) - MLEN=MAX(MLEN,IXGDX+ILNGDX) - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PUT BMS IN INDEX RECORD - IF(INCBMS.NE.0) THEN - ISKBMS=ISKTOT - IBSKIP=LSKIP+ISKBMS - IBREAD=MXBMS - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CALL SBYTEC(CINDEX,ISKBMS,8*IXSBM,8*MXSBM) - CALL GBYTEC(CBREAD,LENBMS,0,8*3) - ILNBMS=MIN(LENBMS,MXBMS) - CINDEX(IXBMS+1:IXBMS+ILNBMS)=CBREAD(1:ILNBMS) - ISKTOT=ISKBMS+LENBMS - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PUT BDS IN INDEX RECORD - ISKBDS=ISKTOT - IBSKIP=LSKIP+ISKBDS - IBREAD=MXBDS - CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD) - IF(LBREAD.NE.IBREAD) RETURN - CALL SBYTEC(CINDEX,ISKBDS,8*IXSBD,8*MXSBD) - CALL GBYTEC(CBREAD,LENBDS,0,8*3) - ILNBDS=MIN(LENBDS,MXBDS) - CINDEX(IXBDS+1:IXBDS+ILNBDS)=CBREAD(1:ILNBDS) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C STORE INDEX RECORD - MLEN=MIN(MLEN,NLEN) - NSKIP=NLEN*(NNUM-1) - CBUF(NSKIP+1:NSKIP+MLEN)=CINDEX(1:MLEN) - CBUF(NSKIP+MLEN+1:NSKIP+NLEN)=CHAR(0) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/lengds.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/lengds.f deleted file mode 100755 index 051aed69f2..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/lengds.f +++ /dev/null @@ -1,40 +0,0 @@ -C----------------------------------------------------------------------- - FUNCTION LENGDS(KGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: LENGDS RETURN THE LENGTH OF A GRID -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-07-19 -C -C ABSTRACT: GIVEN A GRID DESCRIPTION SECTION (IN W3FI63 FORMAT), -C RETURN ITS SIZE IN TERMS OF NUMBER OF DATA POINTS. -C -C PROGRAM HISTORY LOG: -C 96-07-19 IREDELL -C -C USAGE: CALL LENGDS(KGDS) -C INPUT ARGUMENTS: -C KGDS INTEGER (200) GDS PARAMETERS IN W3FI63 FORMAT -C OUTPUT ARGUMENTS: -C LENGDS INTEGER SIZE OF GRID -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN -C -C$$$ - INTEGER KGDS(200) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C SPECIAL CASE OF STAGGERED ETA - IF(KGDS(1).EQ.201) THEN - LENGDS=KGDS(7)*KGDS(8)-KGDS(8)/2 -C SPECIAL CASE OF FILLED ETA - ELSEIF(KGDS(1).EQ.202) THEN - LENGDS=KGDS(7)*KGDS(8) -C SPECIAL CASE OF THINNED WAFS - ELSEIF(KGDS(19).EQ.0.AND.KGDS(20).NE.255) THEN - LENGDS=KGDS(21) -C GENERAL CASE - ELSE - LENGDS=KGDS(2)*KGDS(3) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/mova2i.c b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/mova2i.c deleted file mode 100755 index e96bac49c0..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/mova2i.c +++ /dev/null @@ -1,65 +0,0 @@ -/*$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: mova2i Moves a bit string from a char*1 to int -C PRGMMR: Gilbert ORG: W/NP11 DATE: 02-08-15 -C -C ABSTRACT: This Function copies a bit string from a Character*1 variable -C to an integer variable. It is intended to replace the Fortran Intrinsic -C Function ICHAR, which only supports 0 <= ICHAR(a) <= 127 on the -C IBM SP. If "a" is greater than 127 in the collating sequence, -C ICHAR(a) does not return the expected bit value. -C This function can be used for all values 0 <= ICHAR(a) <= 255. -C -C PROGRAM HISTORY LOG: -C 98-12-15 Gilbert -C -C USAGE: I = mova2i(a) -C -C INPUT ARGUMENT : -C -C a - Character*1 variable that holds the bitstring to extract -C -C RETURN ARGUMENT : -C -C mova2i - Integer value of the bitstring in character a -C -C REMARKS: -C -C None -C -C ATTRIBUTES: -C LANGUAGE: C -C MACHINE: IBM SP - -C -C$$$i*/ - -#ifdef CRAY90 - #include - int MOVA2I(unsigned char *a) -#endif -#ifdef HP - int mova2i(unsigned char *a) -#endif -#ifdef SGI - int mova2i_(unsigned char *a) -#endif -#ifdef LINUX - int mova2i_(unsigned char *a) -#endif -#ifdef LINUXF90 - int MOVA2I(unsigned char *a) -#endif -#ifdef VPP5000 - int mova2i_(unsigned char *a) -#endif -#ifdef IBM4 - int mova2i(unsigned char *a) -#endif -#ifdef IBM8 - long long int mova2i(unsigned char *a) -#endif - -{ - return (int)(*a); -} diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/mova2i.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/mova2i.f deleted file mode 100755 index 97c34c2826..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/mova2i.f +++ /dev/null @@ -1,52 +0,0 @@ - Integer Function mova2i(a) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: mova2i Moves a bit string from a char*1 to int -C PRGMMR: Gilbert ORG: W/NP11 DATE: 98-12-15 -C -C ABSTRACT: This Function copies a bit string from a Character*1 variable -C to an integer variable. It is intended to replace the Fortran Intrinsic -C Function ICHAR, which only supports 0 <= ICHAR(a) <= 127 on the -C IBM SP. If "a" is greater than 127 in the collating sequence, -C ICHAR(a) does not return the expected bit value when the -qhot -C ( and therefore -qsmp) option is used when compiling. -C This function can be used for all values 0 <= ICHAR(a) <= 255 and -C will work with or without the -qhot compiler option. -C -C PROGRAM HISTORY LOG: -C 98-12-15 Gilbert -C 2001-06-11 Gilbert - added a step to fill an 8-byte character -C array with the same value so that the -C f90 transfer function is more predictable. -C All bytes will now contain the desired value. -C -C USAGE: I = mova2i(a) -C -C INPUT ARGUMENT : -C -C a - Character*1 variable that holds the bitstring to extract -C -C RETURN ARGUMENT : -C -C mova2i - Integer value of the bitstring in character a -C -C REMARKS: -C -C None -C -C ATTRIBUTES: -C LANGUAGE: IBM XL FORTRAN -C MACHINE: IBM SP -C -C$$$ -C - integer mold - character(len=1) a - character(len=1) ctemp(8) - - ctemp(1:8)=a -c mova2i=ishft(transfer(ctemp,mold),8-bit_size(mold)) - mova2i=iand(transfer(ctemp,mold),255) - - return - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/pdsens.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/pdsens.f deleted file mode 100755 index a506802611..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/pdsens.f +++ /dev/null @@ -1,76 +0,0 @@ -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: PDSENS.F PACKS GRIB PDS EXTENSION 41- FOR ENSEMBLE -C PRGMMR: RICHARD WOBUS ORG: W/NP20 DATE: 98-09-28 -C -C ABSTRACT: PACKS BRIB PDS EXTENSION STARTING ON BYTE 41 FOR ENSEMBLE -C FORECAST PRODUCTS. FOR FORMAT OF PDS EXTENSION, SEE NMC OFFICE NOTE 38 -C -C PROGRAM HISTORY LOG: -C 95-03-14 ZOLTAN TOTH AND MARK IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-09-28 WOBUS CORRECTED MEMBER ENTRY, BLANK ALL UNUSED FIELDS -C 2001-06-05 IREDELL APPLY LINUX PORT BY EBISUZAKI -C -C USAGE: CALL PDSENS.F(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) -C INPUT ARGUMENT LIST: -C KENS(5) - BYTES 41-45 (GENERAL SECTION, ALWAYS PRESENT.) -C KPROB(2) - BYTES 46-47 (PROBABILITY SECTION, PRESENT ONLY IF NEEDE -C XPROB(2) - BYTES 48-51&52-55 (PROBABILITY SECTION, IF NEEDED.) -C KCLUST(16)-BYTES 61-76 (CLUSTERING SECTION, IF NEEDED.) -C KMEMBR(80)-BYTES 77-86 (CLUSTER MEMBERSHIP SECTION, IF NEEDED.) -C ILAST - LAST BYTE TO BE PACKED (IF GREATER OR EQUAL TO FIRST BY -C IN ANY OF FOUR SECTIONS ABOVE, WHOLE SECTION IS PACKED. -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C MSGA - FULL PDS SECTION, INCLUDING NEW ENSEMBLE EXTENSION -C -C REMARKS: USE PDSEUP.F FOR UNPACKING PDS ENSEMBLE EXTENSION. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ -C TESTING GRIB EXTENSION 41- PACKER AND UNPACKER SUBROUTINES -C -CFPP$ NOCONCUR R - SUBROUTINE PDSENS(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) - INTEGER KENS(5),KPROB(2),KCLUST(16),KMEMBR(80) - DIMENSION XPROB(2) - CHARACTER*1 MSGA(100) - IF(ILAST.LT.41) THEN - GO TO 333 - ENDIF -C PACKING IS DONE IN FOUR SECTIONS ENDING AT BYTE IL - IF(ILAST.GE.41) IL=45 - IF(ILAST.GE.46) IL=55 - IF(ILAST.GE.61) IL=76 - IF(ILAST.GE.77) IL=86 - do i=42,il - CALL SBYTEC(MSGA, 0, i*8, 8) - enddo -C CHANGING THE NUMBER OF BYTES (FIRST THREE BYTES IN PDS) - CALL SBYTEC(MSGA, IL, 0,24) -C PACKING FIRST SECTION (GENERAL INTORMATION SECTION) - IF(IL.GE.45) CALL SBYTESC(MSGA,KENS,40*8,8,0,5) -C PACKING 2ND SECTION (PROBABILITY SECTION) - IF(IL.GE.55) THEN - CALL SBYTESC(MSGA,KPROB,45*8,8,0,2) - CALL W3FI01(LW) - CALL W3FI76(XPROB(1),IEXP,IMANT,8*LW) - CALL SBYTEC(MSGA,IEXP,47*8,8) - CALL SBYTEC(MSGA,IMANT,48*8,24) - CALL W3FI76(XPROB(2),IEXP,IMANT,8*LW) - CALL SBYTEC(MSGA,IEXP,51*8,8) - CALL SBYTEC(MSGA,IMANT,52*8,24) - ENDIF -C PACKING 3RD SECTION (CLUSTERING INFORMATION) - IF(IL.GE.76) CALL SBYTESC(MSGA,KCLUST,60*8,8,0,16) -C PACKING 4TH SECTION (CLUSTER MEMBERSHIP) - IF(IL.GE.86) CALL SBYTESC(MSGA,KMEMBR,76*8,1,0,80) -C - 333 CONTINUE - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/pdseup.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/pdseup.f deleted file mode 100755 index 7127a25887..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/pdseup.f +++ /dev/null @@ -1,74 +0,0 @@ -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: PDSEUP.F UNPACKS GRIB PDS EXTENSION 41- FOR ENSEMBLE -C PRGMMR: RICHARD WOBUS ORG: W/NP20 DATE: 98-09-28 -C -C ABSTRACT: UNPACKS GRIB PDS EXTENSION STARTING ON BYTE 41 FOR ENSEMBLE -C FORECAST PRODUCTS. FOR FORMAT OF PDS EXTENSION, SEE NMC OFFICE NOTE 38 -C -C PROGRAM HISTORY LOG: -C 95-03-14 ZOLTAN TOTH AND MARK IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-09-28 WOBUS CORRECTED MEMBER EXTRACTION -C 2001-06-05 IREDELL APPLY LINUX PORT BY EBISUZAKI -C -C USAGE: CALL PDSENS.F(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) -C INPUT ARGUMENT LIST: -C ILAST - LAST BYTE TO BE UNPACKED (IF GREATER/EQUAL TO FIRST BYT -C IN ANY OF FOUR SECTIONS BELOW, WHOLE SECTION IS PACKED. -C MSGA - FULL PDS SECTION, INCLUDING NEW ENSEMBLE EXTENSION -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C KENS(5) - BYTES 41-45 (GENERAL SECTION, ALWAYS PRESENT.) -C KPROB(2) - BYTES 46-47 (PROBABILITY SECTION, PRESENT ONLY IF NEEDE -C XPROB(2) - BYTES 48-51&52-55 (PROBABILITY SECTION, IF NEEDED.) -C KCLUST(16)-BYTES 61-76 (CLUSTERING SECTION, IF NEEDED.) -C KMEMBR(80)-BYTES 77-86 (CLUSTER MEMBERSHIP SECTION, IF NEEDED.) -C -C REMARKS: USE PDSENS.F FOR PACKING PDS ENSEMBLE EXTENSION. -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: CF77 FORTRAN -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ -C - SUBROUTINE PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) - INTEGER KENS(5),KPROB(2),KCLUST(16),KMEMBR(80) - DIMENSION XPROB(2) - CHARACTER*1 MSGA(100) -C CHECKING TOTAL NUMBER OF BYTES IN PDS (IBYTES) - CALL GBYTEC(MSGA, IBYTES, 0,24) - IF(ILAST.GT.IBYTES) THEN -C ILAST=IBYTES - GO TO 333 - ENDIF - IF(ILAST.LT.41) THEN - GO TO 333 - ENDIF -C UNPACKING FIRST SECTION (GENERAL INFORMATION) - CALL GBYTESC(MSGA,KENS,40*8,8,0,5) -C UNPACKING 2ND SECTION (PROBABILITY SECTION) - IF(ILAST.GE.46) THEN - CALL GBYTESC(MSGA,KPROB,45*8,8,0,2) -C - CALL GBYTEC (MSGA,JSGN,47*8,1) - CALL GBYTEC (MSGA,JEXP,47*8+1,7) - CALL GBYTEC (MSGA,IFR,47*8+8,24) - XPROB(1)=(-1)**JSGN*IFR*16.**(JEXP-70) -C - CALL GBYTEC (MSGA,JSGN,51*8,1) - CALL GBYTEC (MSGA,JEXP,51*8+1,7) - CALL GBYTEC (MSGA,IFR,51*8+8,24) - XPROB(2)=(-1)**JSGN*IFR*16.**(JEXP-70) - ENDIF -C -C UNPACKING 3RD SECTION (CLUSTERING INFORMATION) - IF(ILAST.GE.61) CALL GBYTESC(MSGA,KCLUST,60*8,8,0,16) -C UNPACKING 4TH SECTION (CLUSTERMEMBERSHIP INFORMATION) - IF(ILAST.GE.77) CALL GBYTESC(MSGA,KMEMBR,76*8,1,0,80) -C - 333 CONTINUE - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgb.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgb.f deleted file mode 100755 index e9207c6233..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgb.f +++ /dev/null @@ -1,201 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGB(LUGB,KF,KPDS,KGDS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGB PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGB. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL PUTGB(LUGB,KF,KPDS,KGDS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200) - LOGICAL*1 LB(KF) - REAL F(KF) - PARAMETER(MAXBIT=16) - INTEGER IBM(KF),IPDS(200),IGDS(200),IBDS(200) - REAL FR(KF) - CHARACTER PDS(400),GRIB(1000+KF*(MAXBIT+1)/8) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET W3FI72 PARAMETERS - CALL R63W72(KPDS,KGDS,IPDS,IGDS) - IBDS=0 - ICOMP=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COUNT VALID DATA - KBM=KF - IF(IPDS(7).NE.0) THEN - KBM=0 - DO I=1,KF - IF(LB(I)) THEN - IBM(I)=1 - KBM=KBM+1 - ELSE - IBM(I)=0 - ENDIF - ENDDO - IF(KBM.EQ.KF) IPDS(7)=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET NUMBER OF BITS AND ROUND DATA - IF(KBM.EQ.0) THEN - DO I=1,KF - FR(I)=0. - ENDDO - NBIT=0 - ELSE - CALL GETBIT(IPDS(7),0,IPDS(25),KF,IBM,F,FR,FMIN,FMAX,NBIT) - NBIT=MIN(NBIT,MAXBIT) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PACK AND WRITE GRIB DATA - CALL W3FI72(0,FR,0,NBIT,0,IPDS,PDS, - & 1,255,IGDS,ICOMP,0,IBM,KF,IBDS, - & KFO,GRIB,LGRIB,IRET) - IF(IRET.EQ.0) CALL WRYTE(LUGB,LGRIB,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbe.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbe.f deleted file mode 100755 index 57b75673be..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbe.f +++ /dev/null @@ -1,213 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGBE(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGBE PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGBE. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL PUTGBE(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C KENS INTEGER (200) ENSEMBLE PDS PARMS -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - LOGICAL*1 LB(KF) - REAL F(KF) - PARAMETER(MAXBIT=16) - INTEGER IBM(KF),IPDS(200),IGDS(200),IBDS(200) - REAL FR(KF) - CHARACTER PDS(400),GRIB(1000+KF*(MAXBIT+1)/8) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET W3FI72 PARAMETERS - CALL R63W72(KPDS,KGDS,IPDS,IGDS) - IBDS=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COUNT VALID DATA - KBM=KF - IF(IPDS(7).NE.0) THEN - KBM=0 - DO I=1,KF - IF(LB(I)) THEN - IBM(I)=1 - KBM=KBM+1 - ELSE - IBM(I)=0 - ENDIF - ENDDO - IF(KBM.EQ.KF) IPDS(7)=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET NUMBER OF BITS AND ROUND DATA - IF(KBM.EQ.0) THEN - DO I=1,KF - FR(I)=0. - ENDDO - NBIT=0 - ELSE - CALL GETBIT(IPDS(7),0,IPDS(25),KF,IBM,F,FR,FMIN,FMAX,NBIT) - NBIT=MIN(NBIT,MAXBIT) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CREATE PRODUCT DEFINITION SECTION - CALL W3FI68(IPDS,PDS) - IF(IPDS(24).EQ.2) THEN - ILAST=45 - CALL PDSENS(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,PDS) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PACK AND WRITE GRIB DATA - CALL W3FI72(0,FR,0,NBIT,1,IPDS,PDS, - & 1,255,IGDS,0,0,IBM,KF,IBDS, - & KFO,GRIB,LGRIB,IRET) - IF(IRET.EQ.0) CALL WRYTE(LUGB,LGRIB,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgben.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgben.f deleted file mode 100755 index cdae860075..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgben.f +++ /dev/null @@ -1,223 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGBEN(LUGB,KF,KPDS,KGDS,KENS,IBS,NBITS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGBEN PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGBE. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 2001-03-16 IREDELL CORRECTED ARGUMENT LIST TO INCLUDE IBS -C -C USAGE: CALL PUTGBEN(LUGB,KF,KPDS,KGDS,KENS,IBS,NBITS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C KENS INTEGER (200) ENSEMBLE PDS PARMS -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C IBS INTEGER BINARY SCALE FACTOR (0 TO IGNORE) -C NBITS INTEGER NUMBER OF BITS IN WHICH TO PACK (0 TO IGNORE) -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - LOGICAL*1 LB(KF) - REAL F(KF) - PARAMETER(MAXBIT=16) - INTEGER IBM(KF),IPDS(200),IGDS(200),IBDS(200) - REAL FR(KF) - CHARACTER PDS(400),GRIB(1000+KF*(MAXBIT+1)/8) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET W3FI72 PARAMETERS - CALL R63W72(KPDS,KGDS,IPDS,IGDS) - IBDS=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COUNT VALID DATA - KBM=KF - IF(IPDS(7).NE.0) THEN - KBM=0 - DO I=1,KF - IF(LB(I)) THEN - IBM(I)=1 - KBM=KBM+1 - ELSE - IBM(I)=0 - ENDIF - ENDDO - IF(KBM.EQ.KF) IPDS(7)=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET NUMBER OF BITS AND ROUND DATA - IF(NBITS.GT.0) THEN - DO I=1,KF - FR(I)=F(I) - ENDDO - NBIT=NBITS - ELSE - IF(KBM.EQ.0) THEN - DO I=1,KF - FR(I)=0. - ENDDO - NBIT=0 - ELSE - CALL GETBIT(IPDS(7),IBS,IPDS(25),KF,IBM,F,FR,FMIN,FMAX,NBIT) - NBIT=MIN(NBIT,MAXBIT) - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CREATE PRODUCT DEFINITION SECTION - CALL W3FI68(IPDS,PDS) - IF(IPDS(24).EQ.2) THEN - ILAST=45 - CALL PDSENS(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,PDS) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PACK AND WRITE GRIB DATA - CALL W3FI72(0,FR,0,NBIT,1,IPDS,PDS, - & 1,255,IGDS,0,0,IBM,KF,IBDS, - & KFO,GRIB,LGRIB,IRET) - IF(IRET.EQ.0) CALL WRYTE(LUGB,LGRIB,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbens.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbens.f deleted file mode 100755 index 6d01c137a3..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbens.f +++ /dev/null @@ -1,167 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGBENS(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGBENS PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGBENS. -C THIS OBSOLESCENT VERSION HAS BEEN REPLACED BY PUTGBE. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL PUTGBENS(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C KENS INTEGER (200) ENSEMBLE PDS PARMS -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C PUTGBE PACK AND WRITE GRIB MESSAGE -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - LOGICAL*1 LB(KF) - REAL F(KF) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PRINT *,'PLEASE USE PUTGBE RATHER THAN PUTGBENS' - CALL PUTGBE(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbex.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbex.f deleted file mode 100755 index f21413e449..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbex.f +++ /dev/null @@ -1,222 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGBEX(LUGB,KF,KPDS,KGDS,KENS, - & KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGBE PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGBE. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 97-02-11 Y.ZHU INCLUDED PROBABILITY AND CLUSTER ARGUMENTS -C -C USAGE: CALL PUTGBE(LUGB,KF,KPDS,KGDS,KENS, -C & KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C KENS INTEGER (200) ENSEMBLE PDS PARMS -C (1) - APPLICATION IDENTIFIER -C (2) - ENSEMBLE TYPE -C (3) - ENSEMBLE IDENTIFIER -C (4) - PRODUCT IDENTIFIER -C (5) - SMOOTHING FLAG -C KPROB INTEGER (2) PROBABILITY ENSEMBLE PARMS -C XPROB REAL (2) PROBABILITY ENSEMBLE PARMS -C KCLUST INTEGER (16) CLUSTER ENSEMBLE PARMS -C KMEMBR INTEGER (8) CLUSTER ENSEMBLE PARMS -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200),KENS(200) - INTEGER KPROB(2),KCLUST(16),KMEMBR(80) - REAL XPROB(2) - LOGICAL*1 LB(KF) - REAL F(KF) - PARAMETER(MAXBIT=16) - INTEGER IBM(KF),IPDS(200),IGDS(200),IBDS(200) - REAL FR(KF) - CHARACTER PDS(400),GRIB(1000+KF*(MAXBIT+1)/8) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET W3FI72 PARAMETERS - CALL R63W72(KPDS,KGDS,IPDS,IGDS) - IBDS=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COUNT VALID DATA - KBM=KF - IF(IPDS(7).NE.0) THEN - KBM=0 - DO I=1,KF - IF(LB(I)) THEN - IBM(I)=1 - KBM=KBM+1 - ELSE - IBM(I)=0 - ENDIF - ENDDO - IF(KBM.EQ.KF) IPDS(7)=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET NUMBER OF BITS AND ROUND DATA - IF(KBM.EQ.0) THEN - DO I=1,KF - FR(I)=0. - ENDDO - NBIT=0 - ELSE - CALL GETBIT(IPDS(7),0,IPDS(25),KF,IBM,F,FR,FMIN,FMAX,NBIT) - NBIT=MIN(NBIT,MAXBIT) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C CREATE PRODUCT DEFINITION SECTION - CALL W3FI68(IPDS,PDS) - IF(IPDS(24).EQ.2) THEN - ILAST=86 - CALL PDSENS(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,PDS) - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PACK AND WRITE GRIB DATA - CALL W3FI72(0,FR,0,NBIT,1,IPDS,PDS, - & 1,255,IGDS,0,0,IBM,KF,IBDS, - & KFO,GRIB,LGRIB,IRET) - IF(IRET.EQ.0) CALL WRYTE(LUGB,LGRIB,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbn.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbn.f deleted file mode 100755 index 671f1106be..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/putgbn.f +++ /dev/null @@ -1,209 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE PUTGBN(LUGB,KF,KPDS,KGDS,IBS,NBITS,LB,F,IRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: PUTGBN PACKS AND WRITES A GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 -C -C ABSTRACT: PACK AND WRITE A GRIB MESSAGE. -C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGB. -C -C PROGRAM HISTORY LOG: -C 94-04-01 IREDELL -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL PUTGBN(LUGB,KF,KPDS,KGDS,NBITS,LB,F,IRET) -C INPUT ARGUMENTS: -C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE -C KF INTEGER NUMBER OF DATA POINTS -C KPDS INTEGER (200) PDS PARAMETERS -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C KGDS INTEGER (200) GDS PARAMETERS -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C IBS INTEGER BINARY SCALE FACTOR (0 TO IGNORE) -C NBITS INTEGER NUMBER OF BITS IN WHICH TO PACK (0 TO IGNORE) -C LB LOGICAL*1 (KF) BITMAP IF PRESENT -C F REAL (KF) DATA -C OUTPUT ARGUMENTS: -C IRET INTEGER RETURN CODE -C 0 ALL OK -C OTHER W3FI72 GRIB PACKER RETURN CODE -C -C SUBPROGRAMS CALLED: -C R63W72 MAP W3FI63 PARAMETERS ONTO W3FI72 PARAMETERS -C GETBIT GET NUMBER OF BITS AND ROUND DATA -C W3FI72 PACK GRIB -C WRYTE WRITE DATA -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ - INTEGER KPDS(200),KGDS(200) - LOGICAL*1 LB(KF) - REAL F(KF) - PARAMETER(MAXBIT=16) - INTEGER IBM(KF),IPDS(200),IGDS(200),IBDS(200) - REAL FR(KF) - CHARACTER PDS(400),GRIB(1000+KF*(MAXBIT+1)/8) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET W3FI72 PARAMETERS - CALL R63W72(KPDS,KGDS,IPDS,IGDS) - IBDS=0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C COUNT VALID DATA - KBM=KF - IF(IPDS(7).NE.0) THEN - KBM=0 - DO I=1,KF - IF(LB(I)) THEN - IBM(I)=1 - KBM=KBM+1 - ELSE - IBM(I)=0 - ENDIF - ENDDO - IF(KBM.EQ.KF) IPDS(7)=0 - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C GET NUMBER OF BITS AND ROUND DATA - IF(NBITS.GT.0) THEN - DO I=1,KF - FR(I)=F(I) - ENDDO - NBIT=NBITS - ELSE - IF(KBM.EQ.0) THEN - DO I=1,KF - FR(I)=0. - ENDDO - NBIT=0 - ELSE - CALL GETBIT(IPDS(7),IBS,IPDS(25),KF,IBM,F,FR,FMIN,FMAX,NBIT) - NBIT=MIN(NBIT,MAXBIT) - ENDIF - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C PACK AND WRITE GRIB DATA - CALL W3FI72(0,FR,0,NBIT,0,IPDS,PDS, - & 1,255,IGDS,0,0,IBM,KF,IBDS, - & KFO,GRIB,LGRIB,IRET) - IF(IRET.EQ.0) CALL WRYTE(LUGB,LGRIB,GRIB) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/r63w72.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/r63w72.f deleted file mode 100755 index 4d52ab96aa..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/r63w72.f +++ /dev/null @@ -1,125 +0,0 @@ - SUBROUTINE R63W72(KPDS,KGDS,IPDS,IGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: R63W72 CONVERT W3FI63 PARMS TO W3FI72 PARMS -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 92-10-31 -C -C ABSTRACT: 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 91-10-31 MARK IREDELL -C 96-05-03 MARK IREDELL CORRECTED SOME LEVEL TYPES AND -C SOME DATA REPRESENTATION TYPES -C 97-02-14 MARK IREDELL ONLY ALTERED IPDS(26:27) FOR EXTENDED PDS -C 98-06-01 CHRIS CARUSO Y2K FIX FOR YEAR OF CENTURY -C 2005-05-06 DIANE STOKES RECOGNIZE LEVEL 236 -C -C USAGE: CALL R63W72(KPDS,KGDS,IPDS,IGDS) -C -C INPUT ARGUMENT LIST: -C KPDS - INTEGER (200) PDS PARAMETERS FROM W3FI63 -C KGDS - INTEGER (200) GDS PARAMETERS FROM W3FI63 -C -C OUTPUT ARGUMENT LIST: -C IPDS - INTEGER (200) PDS PARAMETERS FOR W3FI72 -C IGDS - INTEGER (200) GDS PARAMETERS FOR W3FI72 -C -C REMARKS: KGDS AND IGDS EXTEND BEYOND THEIR DIMENSIONS HERE -C IF PL PARAMETERS ARE PRESENT. -C -C ATTRIBUTES: -C LANGUAGE: CRAY FORTRAN -C -C$$$ - 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 - ELSE - IPDS(1)=45 ! LENGTH OF PDS - ENDIF - IPDS(2)=KPDS(19) ! PARAMETER TABLE VERSION - IPDS(3)=KPDS(1) ! ORIGINATING CENTER - IPDS(4)=KPDS(2) ! GENERATING MODEL - IPDS(5)=KPDS(3) ! GRID DEFINITION - IPDS(6)=MOD(KPDS(4)/128,2) ! GDS FLAG - IPDS(7)=MOD(KPDS(4)/64,2) ! BMS FLAG - IPDS(8)=KPDS(5) ! PARAMETER INDICATOR - IPDS(9)=KPDS(6) ! LEVEL TYPE - IF(KPDS(6).EQ.101.OR.KPDS(6).EQ.104.OR.KPDS(6).EQ.106.OR. - & KPDS(6).EQ.108.OR.KPDS(6).EQ.110.OR.KPDS(6).EQ.112.OR. - & KPDS(6).EQ.114.OR.KPDS(6).EQ.116.OR.KPDS(6).EQ.121.OR. - & KPDS(6).EQ.128.OR.KPDS(6).EQ.141.OR.KPDS(6).EQ.236) THEN - IPDS(10)=MOD(KPDS(7)/256,256) ! LEVEL VALUE 1 - IPDS(11)=MOD(KPDS(7),256) ! LEVEL VALUE 2 - ELSE - IPDS(10)=0 ! LEVEL VALUE 1 - IPDS(11)=KPDS(7) ! LEVEL VALUE 2 - ENDIF - IPDS(12)=KPDS(8) ! YEAR OF CENTURY - IPDS(13)=KPDS(9) ! MONTH - IPDS(14)=KPDS(10) ! DAY - IPDS(15)=KPDS(11) ! HOUR - IPDS(16)=KPDS(12) ! MINUTE - IPDS(17)=KPDS(13) ! FORECAST TIME UNIT - IPDS(18)=KPDS(14) ! TIME RANGE 1 - IPDS(19)=KPDS(15) ! TIME RANGE 2 - IPDS(20)=KPDS(16) ! TIME RANGE INDICATOR - IPDS(21)=KPDS(17) ! NUMBER IN AVERAGE - IPDS(22)=KPDS(20) ! NUMBER MISSING IN AVERAGE - IPDS(23)=KPDS(21) ! CENTURY - IPDS(24)=KPDS(23) ! SUBCENTER - IPDS(25)=KPDS(22) ! DECIMAL SCALING - IF(IPDS(1).GT.28) THEN - 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 - IGDS(3)=KGDS(1) ! DATA REPRESENTATION - IGDS(4)=KGDS(2) ! (UNIQUE TO REPRESENTATION) - IGDS(5)=KGDS(3) ! (UNIQUE TO REPRESENTATION) - IGDS(6)=KGDS(4) ! (UNIQUE TO REPRESENTATION) - IGDS(7)=KGDS(5) ! (UNIQUE TO REPRESENTATION) - IGDS(8)=KGDS(6) ! (UNIQUE TO REPRESENTATION) - IGDS(9)=KGDS(7) ! (UNIQUE TO REPRESENTATION) - IGDS(10)=KGDS(8) ! (UNIQUE TO REPRESENTATION) - IGDS(11)=KGDS(9) ! (UNIQUE TO REPRESENTATION) - IGDS(12)=KGDS(10) ! (UNIQUE TO REPRESENTATION) - IGDS(13)=KGDS(11) ! (UNIQUE TO REPRESENTATION) - IGDS(14)=KGDS(12) ! (UNIQUE TO REPRESENTATION) - IGDS(15)=KGDS(13) ! (UNIQUE TO REPRESENTATION) - IGDS(16)=KGDS(14) ! (UNIQUE TO REPRESENTATION) - IGDS(17)=KGDS(15) ! (UNIQUE TO REPRESENTATION) - IGDS(18)=KGDS(16) ! (UNIQUE TO REPRESENTATION) -C EXCEPTIONS FOR LATLON OR GAUSSIAN - IF(KGDS(1).EQ.0.OR.KGDS(1).EQ.4) THEN - IGDS(11)=KGDS(10) - IGDS(12)=KGDS(9) -C EXCEPTIONS FOR MERCATOR - ELSEIF(KGDS(1).EQ.1) THEN - IGDS(11)=KGDS(13) - IGDS(12)=KGDS(12) - IGDS(13)=KGDS(9) - IGDS(14)=KGDS(11) -C EXCEPTIONS FOR LAMBERT CONFORMAL - ELSEIF(KGDS(1).EQ.3) THEN - IGDS(15)=KGDS(12) - IGDS(16)=KGDS(13) - IGDS(17)=KGDS(14) - IGDS(18)=KGDS(15) - ENDIF -C EXTENSION FOR PL PARAMETERS - IF(KGDS(1).EQ.0.AND.KGDS(19).EQ.0.AND.KGDS(20).NE.255) THEN - DO J=1,KGDS(3) - IGDS(18+J)=KGDS(21+J) - ENDDO - ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/sbyte.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/sbyte.f deleted file mode 100755 index df958fd0bd..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/sbyte.f +++ /dev/null @@ -1,79 +0,0 @@ - SUBROUTINE SBYTE(IOUT,IN,ISKIP,NBYTE) -C THIS PROGRAM WRITTEN BY..... -C DR. ROBERT C. GAMMILL, CONSULTANT -C NATIONAL CENTER FOR ATMOSPHERIC RESEARCH -C JULY 1972 -C -C THIS IS THE FORTRAN 32 bit VERSION OF SBYTE. -C Changes for SiliconGraphics IRIS-4D/25 -C SiliconGraphics 3.3 FORTRAN 77 -C MARCH 1991 RUSSELL E. JONES -C NATIONAL WEATHER SERVICE -C - INTEGER IN - INTEGER IOUT(*) - INTEGER MASKS(32) -C - SAVE -C - DATA NBITSW/32/ -C -C DATA MASKS /Z'00000001',Z'00000003',Z'00000007',Z'0000000F', -C & Z'0000001F',Z'0000003F',Z'0000007F',Z'000000FF', -C & Z'000001FF',Z'000003FF',Z'000007FF',Z'00000FFF', -C & Z'00001FFF',Z'00003FFF',Z'00007FFF',Z'0000FFFF', -C & Z'0001FFFF',Z'0003FFFF',Z'0007FFFF',Z'000FFFFF', -C & Z'001FFFFF',Z'003FFFFF',Z'007FFFFF',Z'00FFFFFF', -C & Z'01FFFFFF',Z'03FFFFFF',Z'07FFFFFF',Z'0FFFFFFF', -C & Z'1FFFFFFF',Z'3FFFFFFF',Z'7FFFFFFF',Z'FFFFFFFF'/ -C -C MASK TABLE PUT IN DECIMAL SO IT WILL COMPILE ON AN 32 BIT -C COMPUTER -C - DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, - & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, - & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, - & 67108863, 134217727, 268435455, 536870911, 1073741823, - & 2147483647, -1/ -C -C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW -C - ICON = NBITSW - NBYTE - IF (ICON.LT.0) RETURN - MASK = MASKS(NBYTE) -C -C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED. -C - INDEX = ISHFT(ISKIP,-5) -C -C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT. -C - II = MOD(ISKIP,NBITSW) -C - J = IAND(MASK,IN) - MOVEL = ICON - II -C -C BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT. -C - IF (MOVEL.GT.0) THEN - MSK = ISHFT(MASK,MOVEL) - IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), - & ISHFT(J,MOVEL)) -C -C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK. -C - ELSE IF (MOVEL.LT.0) THEN - MSK = MASKS(NBYTE+MOVEL) - IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), - & ISHFT(J,MOVEL)) - ITEMP = IAND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2)) - IOUT(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL)) -C -C BYTE IS TO BE STORED RIGHT-ADJUSTED. -C - ELSE - IOUT(INDEX+1) = IOR(IAND(NOT(MASK),IOUT(INDEX+1)),J) - ENDIF -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/sbytes.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/sbytes.f deleted file mode 100755 index 5a1490675e..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/sbytes.f +++ /dev/null @@ -1,101 +0,0 @@ - SUBROUTINE SBYTES(IOUT,IN,ISKIP,NBYTE,NSKIP,N) -C THIS PROGRAM WRITTEN BY..... -C DR. ROBERT C. GAMMILL, CONSULTANT -C NATIONAL CENTER FOR ATMOSPHERIC RESEARCH -C JULY 1972 -C THIS IS THE FORTRAN VERSIONS OF SBYTES. -C -C Changes for SiliconGraphics IRIS-4D/25 -C SiliconGraphics 3.3 FORTRAN 77 -C March 1991 RUSSELL E. JONES -C NATIONAL WEATHER SERVICE -C - INTEGER IN(*) - INTEGER IOUT(*) - INTEGER MASKS(32) -C - SAVE -C - DATA NBITSW/32/ -C -C DATA MASKS /Z'00000001',Z'00000003',Z'00000007',Z'0000000F', -C & Z'0000001F',Z'0000003F',Z'0000007F',Z'000000FF', -C & Z'000001FF',Z'000003FF',Z'000007FF',Z'00000FFF', -C & Z'00001FFF',Z'00003FFF',Z'00007FFF',Z'0000FFFF', -C & Z'0001FFFF',Z'0003FFFF',Z'0007FFFF',Z'000FFFFF', -C & Z'001FFFFF',Z'003FFFFF',Z'007FFFFF',Z'00FFFFFF', -C & Z'01FFFFFF',Z'03FFFFFF',Z'07FFFFFF',Z'0FFFFFFF', -C & Z'1FFFFFFF',Z'3FFFFFFF',Z'7FFFFFFF',Z'FFFFFFFF'/ -C -C MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT -C COMPUTER -C - DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, - & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, - & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, - & 67108863, 134217727, 268435455, 536870911, 1073741823, - & 2147483647, -1/ -C -C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW -C - ICON = NBITSW - NBYTE - IF (ICON.LT.0) RETURN - MASK = MASKS(NBYTE) -C -C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED. -C - INDEX = ISHFT(ISKIP,-5) -C -C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT. -C - II = MOD(ISKIP,NBITSW) -C -C ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT. -C - ISTEP = NBYTE + NSKIP -C -C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT. -C - IWORDS = ISTEP / NBITSW -C -C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS. -C - IBITS = MOD(ISTEP,NBITSW) -C - DO 10 I = 1,N - J = IAND(MASK,IN(I)) - MOVEL = ICON - II -C -C BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT. -C - IF (MOVEL.GT.0) THEN - MSK = ISHFT(MASK,MOVEL) - IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), - & ISHFT(J,MOVEL)) -C -C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK. -C - ELSE IF (MOVEL.LT.0) THEN - MSK = MASKS(NBYTE+MOVEL) - IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), - & ISHFT(J,MOVEL)) - ITEMP = IAND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2)) - IOUT(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL)) -C -C BYTE IS TO BE STORED RIGHT-ADJUSTED. -C - ELSE - IOUT(INDEX+1) = IOR(IAND(NOT(MASK),IOUT(INDEX+1)),J) - ENDIF -C - II = II + IBITS - INDEX = INDEX + IWORDS - IF (II.GE.NBITSW) THEN - II = II - NBITSW - INDEX = INDEX + 1 - ENDIF -C -10 CONTINUE -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/skgb.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/skgb.f deleted file mode 100755 index fed4654754..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/skgb.f +++ /dev/null @@ -1,78 +0,0 @@ -C----------------------------------------------------------------------- - SUBROUTINE SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: SKGB SEARCH FOR NEXT GRIB MESSAGE -C PRGMMR: IREDELL ORG: W/NMC23 DATE: 93-11-22 -C -C ABSTRACT: THIS SUBPROGRAM SEARCHES A FILE FOR THE NEXT GRIB 1 MESSAGE. -C A GRIB 1 MESSAGE IS IDENTIFIED BY ITS INDICATOR SECTION, I.E. -C AN 8-BYTE SEQUENCE WITH 'GRIB' IN BYTES 1-4 AND 1 IN BYTE 8. -C IF FOUND, THE LENGTH OF THE MESSAGE IS DECODED FROM BYTES 5-7. -C THE SEARCH IS DONE OVER A GIVEN SECTION OF THE FILE. -C THE SEARCH IS TERMINATED IF AN EOF OR I/O ERROR IS ENCOUNTERED. -C -C PROGRAM HISTORY LOG: -C 93-11-22 IREDELL -C 95-10-31 IREDELL ADD CALL TO BAREAD -C 97-03-14 IREDELL CHECK FOR '7777' -C 2001-12-05 GILBERT MODIFIED TO ALSO LOOK FOR GRIB2 MESSAGES -C -C USAGE: CALL SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB) -C INPUT ARGUMENTS: -C LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE -C ISEEK INTEGER NUMBER OF BYTES TO SKIP BEFORE SEARCH -C MSEEK INTEGER MAXIMUM NUMBER OF BYTES TO SEARCH -C OUTPUT ARGUMENTS: -C LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE MESSAGE -C LGRIB INTEGER NUMBER OF BYTES IN MESSAGE (0 IF NOT FOUND) -C -C SUBPROGRAMS CALLED: -C BAREAD BYTE-ADDRESSABLE READ -C GBYTEC GET INTEGER DATA FROM BYTES -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN -C -C$$$ - PARAMETER(LSEEK=128) - CHARACTER Z(LSEEK) - CHARACTER Z4(4) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - LGRIB=0 - KS=ISEEK - KN=MIN(LSEEK,MSEEK) - KZ=LSEEK -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -C LOOP UNTIL GRIB MESSAGE IS FOUND - DOWHILE(LGRIB.EQ.0.AND.KN.GE.8.AND.KZ.EQ.LSEEK) -C READ PARTIAL SECTION - CALL BAREAD(LUGB,KS,KN,KZ,Z) - KM=KZ-8+1 - K=0 -C LOOK FOR 'GRIB...1' IN PARTIAL SECTION - DOWHILE(LGRIB.EQ.0.AND.K.LT.KM) - CALL GBYTEC(Z,I4,(K+0)*8,4*8) - CALL GBYTEC(Z,I1,(K+7)*8,1*8) - IF(I4.EQ.1196575042.AND.(I1.EQ.1.OR.I1.EQ.2)) THEN -C LOOK FOR '7777' AT END OF GRIB MESSAGE - IF (I1.EQ.1) CALL GBYTEC(Z,KG,(K+4)*8,3*8) - IF (I1.EQ.2) CALL GBYTEC(Z,KG,(K+12)*8,4*8) - CALL BAREAD(LUGB,KS+K+KG-4,4,K4,Z4) - IF(K4.EQ.4) THEN - CALL GBYTEC(Z4,I4,0,4*8) - IF(I4.EQ.926365495) THEN -C GRIB MESSAGE FOUND - LSKIP=KS+K - LGRIB=KG - ENDIF - ENDIF - ENDIF - K=K+1 - ENDDO - KS=KS+KM - KN=MIN(LSEEK,ISEEK+MSEEK-KS) - ENDDO -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/start.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/start.f deleted file mode 100755 index a7a490ee99..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/start.f +++ /dev/null @@ -1,2 +0,0 @@ - subroutine start - end subroutine diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/summary.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/summary.f deleted file mode 100755 index 5d925c8743..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/summary.f +++ /dev/null @@ -1,2 +0,0 @@ - subroutine summary - end subroutine diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3difdat.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3difdat.f deleted file mode 100755 index 1e76b6e78f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3difdat.f +++ /dev/null @@ -1,55 +0,0 @@ -!----------------------------------------------------------------------- - subroutine w3difdat(jdat,idat,it,rinc) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! -! SUBPROGRAM: W3DIFDAT RETURN A TIME INTERVAL BETWEEN TWO DATES -! AUTHOR: MARK IREDELL ORG: WP23 DATE: 98-01-05 -! -! ABSTRACT: THIS SUBPROGRAM RETURNS THE ELAPSED TIME INTERVAL FROM -! AN NCEP ABSOLUTE DATE AND TIME GIVEN IN THE SECOND ARGUMENT UNTIL -! AN NCEP ABSOLUTE DATE AND TIME GIVEN IN THE FIRST ARGUMENT. -! THE OUTPUT TIME INTERVAL IS IN ONE OF SEVEN CANONICAL FORMS -! OF THE NCEP RELATIVE TIME INTERVAL DATA STRUCTURE. -! -! PROGRAM HISTORY LOG: -! 98-01-05 MARK IREDELL -! -! USAGE: CALL W3DIFDAT(JDAT,IDAT,IT,RINC) -! -! INPUT VARIABLES: -! JDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! IDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! IT INTEGER RELATIVE TIME INTERVAL FORMAT TYPE -! (-1 FOR FIRST REDUCED TYPE (HOURS ALWAYS POSITIVE), -! 0 FOR SECOND REDUCED TYPE (HOURS CAN BE NEGATIVE), -! 1 FOR DAYS ONLY, 2 FOR HOURS ONLY, 3 FOR MINUTES ONLY, -! 4 FOR SECONDS ONLY, 5 FOR MILLISECONDS ONLY) -! -! OUTPUT VARIABLES: -! RINC REAL (5) NCEP RELATIVE TIME INTERVAL -! (DAYS, HOURS, MINUTES, SECONDS, MILLISECONDS) -! (TIME INTERVAL IS POSITIVE IF JDAT IS LATER THAN IDAT.) -! -! SUBPROGRAMS CALLED: -! IW3JDN COMPUTE JULIAN DAY NUMBER -! W3REDDAT REDUCE A TIME INTERVAL TO A CANONICAL FORM -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - integer jdat(8),idat(8) - real rinc(5) - real rinc1(5) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! difference the days and time and put into canonical form - rinc1(1)=iw3jdn(jdat(1),jdat(2),jdat(3))- - & iw3jdn(idat(1),idat(2),idat(3)) - rinc1(2:5)=jdat(5:8)-idat(5:8) - call w3reddat(it,rinc1,rinc) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3doxdat.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3doxdat.f deleted file mode 100755 index b36ad7c293..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3doxdat.f +++ /dev/null @@ -1,40 +0,0 @@ -!----------------------------------------------------------------------- - subroutine w3doxdat(idat,jdow,jdoy,jday) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! -! SUBPROGRAM: W3DOXDAT RETURN WEEK DAY, YEAR DAY, AND JULIAN DAY -! AUTHOR: MARK IREDELL ORG: WP23 DATE: 98-01-05 -! -! ABSTRACT: THIS SUBPROGRAM RETURNS THE INTEGER DAY OF WEEK, THE DAY -! OF YEAR, AND JULIAN DAY GIVEN AN NCEP ABSOLUTE DATE AND TIME. -! -! PROGRAM HISTORY LOG: -! 98-01-05 MARK IREDELL -! -! USAGE: CALL W3DOXDAT(IDAT,JDOW,JDOY,JDAY) -! -! INPUT VARIABLES: -! IDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! -! OUTPUT VARIABLES: -! JDOW INTEGER DAY OF WEEK (1-7, WHERE 1 IS SUNDAY) -! JDOY INTEGER DAY OF YEAR (1-366, WHERE 1 IS JANUARY 1) -! JDAY INTEGER JULIAN DAY (DAY NUMBER FROM JAN. 1,4713 B.C.) -! -! SUBPROGRAMS CALLED: -! IW3JDN COMPUTE JULIAN DAY NUMBER -! W3FS26 YEAR, MONTH, DAY FROM JULIAN DAY NUMBER -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - integer idat(8) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! get julian day and then get day of week and day of year - jday=iw3jdn(idat(1),idat(2),idat(3)) - call w3fs26(jday,jy,jm,jd,jdow,jdoy) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi01.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi01.f deleted file mode 100755 index a4d87dbccf..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi01.f +++ /dev/null @@ -1,33 +0,0 @@ - SUBROUTINE W3FI01(LW) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI01 DETERMINES MACHINE WORD LENGTH IN BYTES -C PRGMMR: KEYSER ORG: W/NMC22 DATE: 06-29-92 -C -C ABSTRACT: DETERMINES THE NUMBER OF BYTES IN A FULL WORD FOR THE -C PARTICULAR MACHINE (IBM OR CRAY). -C -C PROGRAM HISTORY LOG: -C 92-01-10 R. KISTLER (W/NMC23) -C 92-05-22 D. A. KEYSER -- DOCBLOCKED/COMMENTED -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 2001-06-07 Gilbert Uses f90 standard routine bit_size to -C find integer word length -C -C USAGE: CALL W3FI01(LW) -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C LW - MACHINE WORD LENGTH IN BYTES -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY, WORKSTATIONS -C -C$$$ -C - INTEGER LW - LW=BIT_SIZE(LW) - LW=LW/8 - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi58.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi58.f deleted file mode 100755 index ec8ccf3e48..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi58.f +++ /dev/null @@ -1,115 +0,0 @@ - SUBROUTINE W3FI58(IFIELD,NPTS,NWORK,NPFLD,NBITS,LEN,KMIN) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK *** -C . . . . -C SUBPROGRAM: W3FI58 - PACK POSITIVE DIFFERENCES IN LEAST BITS -C PRGMMR: ALLARD, R. ORG: NMC411 DATE: JULY 1987 -C -C ABSTRACT: CONVERTS AN ARRAY OF INTEGER NUMBERS INTO AN ARRAY OF -C POSITIVE DIFFERENCES (NUMBER(S) - MINIMUM VALUE) AND PACKS THE -C MAGNITUDE OF EACH DIFFERENCE RIGHT-ADJUSTED INTO THE LEAST -C NUMBER OF BITS THAT HOLDS THE LARGEST DIFFERENCE. -C -C PROGRAM HISTORY LOG: -C 87-09-02 ALLARD -C 88-10-02 R.E.JONES CONVERTED TO CDC CYBER 205 FTN200 FORTRAN -C 90-05-17 R.E.JONES CONVERTED TO CRAY CFT77 FORTRAN -C 90-05-18 R.E.JONES CHANGE NAME VBIMPK TO W3LIB NAME W3FI58 -C 96-05-14 IREDELL GENERALIZED COMPUTATION OF NBITS -C 98-06-30 EBISUZAKI LINUX PORT -C -C USAGE: CALL W3FI58(IFIELD,NPTS,NWORK,NPFLD,NBITS,LEN,KMIN) -C -C INPUT: -C -C IFIELD - ARRAY OF INTEGER DATA FOR PROCESSING -C NPTS - NUMBER OF DATA VALUES TO PROCESS IN IFIELD (AND NWORK) -C WHERE, NPTS > 0 -C -C OUTPUT: -C -C NWORK - WORK ARRAY WITH INTEGER DIFFERENCE -C NPFLD - ARRAY FOR PACKED DATA (character*1) -C (USER IS RESPONSIBLE FOR AN ADEQUATE DIMENSION.) -C NBITS - NUMBER OF BITS USED TO PACK DATA WHERE, 0 < NBITS < 32 -C (THE MAXIMUM DIFFERENCE WITHOUT OVERFLOW IS 2**31 -1) -C LEN - NUMBER OF PACKED BYTES IN NPFLD (SET TO 0 IF NO PACKING) -C WHERE, LEN = (NBITS * NPTS + 7) / 8 WITHOUT REMAINDER -C KMIN - MINIMUM VALUE (SUBTRACTED FROM EACH DATUM). IF THIS -C PACKED DATA IS BEING USED FOR GRIB DATA, THE -C PROGRAMER WILL HAVE TO CONVERT THE KMIN VALUE TO AN -C IBM370 32 BIT FLOATING POINT NUMBER. -C -C SUBPROGRAMS CALLED: -C -C W3LIB: SBYTES, SBYTE -C -C EXIT STATES: NONE -C -C NOTE: LEN = 0, NBITS = 0, AND NO PACKING PERFORMED IF -C -C (1) KMAX = KMIN (A CONSTANT FIELD) -C (2) NPTS < 1 (SEE INPUT ARGUMENT) -C -C ATTRIBUTES: -C LANGUAGE: CRAY CFT77 FORTRAN -C MACHINE: CRAY Y-MP8/832 -C -C$$$ -C - PARAMETER(ALOG2=0.69314718056) - INTEGER IFIELD(*) - CHARACTER*1 NPFLD(*) - INTEGER NWORK(*) -C - DATA KZERO / 0 / -C -C / / / / / / -C - LEN = 0 - NBITS = 0 - IF (NPTS.LE.0) GO TO 3000 -C -C FIND THE MAX-MIN VALUES IN INTEGER FIELD (IFIELD). -C - KMAX = IFIELD(1) - KMIN = KMAX - DO 1000 I = 2,NPTS - KMAX = MAX(KMAX,IFIELD(I)) - KMIN = MIN(KMIN,IFIELD(I)) - 1000 CONTINUE -C -C IF A CONSTANT FIELD, RETURN WITH NO PACKING AND 'LEN' AND 'NBITS' SET -C TO ZERO. -C - IF (KMAX.EQ.KMIN) GO TO 3000 -C -C DETERMINE LARGEST DIFFERENCE IN IFIELD AND FLOAT (BIGDIF). -C - BIGDIF = KMAX - KMIN -C -C NBITS IS COMPUTED AS THE LEAST INTEGER SUCH THAT -C BIGDIF < 2**NBITS -C - NBITS=LOG(BIGDIF+0.5)/ALOG2+1 -C -C FORM DIFFERENCES IN NWORK ARRAY. -C - DO 2000 K = 1,NPTS - NWORK(K) = IFIELD(K) - KMIN - 2000 CONTINUE -C -C PACK EACH MAGNITUDE IN NBITS (NBITS = THE LEAST POWER OF 2 OR 'N') -C - LEN=(NBITS*NPTS-1)/8+1 - CALL SBYTESC(NPFLD,NWORK,0,NBITS,0,NPTS) -C -C ADD ZERO-BITS AT END OF PACKED DATA TO INSURE A BYTE BOUNDARY. -C - NOFF = NBITS * NPTS - NZERO=LEN*8-NOFF - IF(NZERO.GT.0) CALL SBYTEC(NPFLD,KZERO,NOFF,NZERO) -C - 3000 CONTINUE - RETURN -C - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi59.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi59.f deleted file mode 100755 index ac430d4a94..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi59.f +++ /dev/null @@ -1,129 +0,0 @@ - SUBROUTINE W3FI59(FIELD,NPTS,NBITS,NWORK,NPFLD,ISCALE,LEN,RMIN) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI59 FORM AND PACK POSITIVE, SCALED DIFFERENCES -C PRGMMR: ALLARD, R. ORG: NMC41 DATE: 84-08-01 -C -C ABSTRACT: CONVERTS AN ARRAY OF SINGLE PRECISION REAL NUMBERS INTO -C AN ARRAY OF POSITIVE SCALED DIFFERENCES (NUMBER(S) - MINIMUM VALUE), -C IN INTEGER FORMAT AND PACKS THE ARGUMENT-SPECIFIED NUMBER OF -C SIGNIFICANT BITS FROM EACH DIFFERENCE. -C -C PROGRAM HISTORY LOG: -C 84-08-01 ALLARD ORIGINAL AUTHOR -C 90-05-17 R.E.JONES CONVERT TO CRAY CFT77 FORTRAN -C 90-05-18 R.E.JONES CHANGE NAME PAKMAG TO W3LIB NAME W3FI59 -C 93-07-06 R.E.JONES ADD NINT TO DO LOOP 2000 SO NUMBERS ARE -C ROUNDED TO NEAREST INTEGER, NOT TRUNCATED. -C 94-01-05 IREDELL COMPUTATION OF ISCALE FIXED WITH RESPECT TO -C THE 93-07-06 CHANGE. -C 98-06-30 EBISUZAKI LINUX PORT -C -C USAGE: CALL W3FI59(FIELD,NPTS,NBITS,NWORK,NPFLD,ISCALE,LEN,RMIN) -C INPUT ARGUMENT LIST: -C FIELD - ARRAY OF FLOATING POINT DATA FOR PROCESSING (REAL) -C NPTS - NUMBER OF DATA VALUES TO PROCESS IN FIELD (AND NWORK) -C WHERE, NPTS > 0 -C NBITS - NUMBER OF SIGNIFICANT BITS OF PROCESSED DATA TO BE PACKED -C WHERE, 0 < NBITS < 32+1 -C -C OUTPUT ARGUMENT LIST: -C NWORK - ARRAY FOR INTEGER CONVERSION (INTEGER) -C IF PACKING PERFORMED (SEE NOTE BELOW), THE ARRAY WILL -C CONTAIN THE PRE-PACKED, RIGHT ADJUSTED, SCALED, INTEGER -C DIFFERENCES UPON RETURN TO THE USER. -C (THE USER MAY EQUIVALENCE FIELD AND NWORK. SAME SIZE.) -C NPFLD - ARRAY FOR PACKED DATA (character*1) -C (DIMENSION MUST BE AT LEAST (NBITS * NPTS) / 64 + 1 ) -C ISCALE- POWER OF 2 FOR RESTORING DATA, SUCH THAT -C DATUM = (DIFFERENCE * 2**ISCALE) + RMIN -C LEN - NUMBER OF PACKED BYTES IN NPFLD (SET TO 0 IF NO PACKING) -C WHERE, LEN = (NBITS * NPTS + 7) / 8 WITHOUT REMAINDER -C RMIN - MINIMUM VALUE (REFERENCE VALUE SUBTRACTED FROM INPUT DATA) -C THIS IS A CRAY FLOATING POINT NUMBER, IT WILL HAVE TO BE -C CONVERTED TO AN IBM370 32 BIT FLOATING POINT NUMBER AT -C SOME POINT IN YOUR PROGRAM IF YOU ARE PACKING GRIB DATA. -C -C REMARKS: LEN = 0 AND NO PACKING PERFORMED IF -C -C (1) RMAX = RMIN (A CONSTANT FIELD) -C (2) NBITS VALUE OUT OF RANGE (SEE INPUT ARGUMENT) -C (3) NPTS VALUE LESS THAN 1 (SEE INPUT ARGUMENT) -C -C ATTRIBUTES: -C LANGUAGE: CRAY CFT77 FORTRAN -C MACHINE: CRAY C916/256, Y-MP8/864, Y-MP EL92/256, J916/2048 -C -C$$$ -C NATURAL LOGARITHM OF 2 AND 0.5 PLUS NOMINAL SAFE EPSILON - PARAMETER(ALOG2=0.69314718056,HPEPS=0.500001) -C - REAL FIELD(*) -C - CHARACTER*1 NPFLD(*) - INTEGER NWORK(*) -C - DATA KZERO / 0 / -C -C / / / / / / -C - LEN = 0 - ISCALE = 0 - IF (NBITS.LE.0.OR.NBITS.GT.32) GO TO 3000 - IF (NPTS.LE.0) GO TO 3000 -C -C FIND THE MAX-MIN VALUES IN FIELD. -C - RMAX = FIELD(1) - RMIN = RMAX - DO 1000 K = 2,NPTS - RMAX = AMAX1(RMAX,FIELD(K)) - RMIN = AMIN1(RMIN,FIELD(K)) - 1000 CONTINUE -C -C IF A CONSTANT FIELD, RETURN WITH NO PACKING PERFORMED AND 'LEN' = 0. -C - IF (RMAX.EQ.RMIN) GO TO 3000 -C -C DETERMINE LARGEST DIFFERENCE IN FIELD (BIGDIF). -C - BIGDIF = RMAX - RMIN -C -C ISCALE IS THE POWER OF 2 REQUIRED TO RESTORE THE PACKED DATA. -C ISCALE IS COMPUTED AS THE LEAST INTEGER SUCH THAT -C BIGDIF*2**(-ISCALE) < 2**NBITS-0.5 -C IN ORDER TO ENSURE THAT THE PACKED INTEGERS (COMPUTED IN LOOP 2000 -C WITH THE NEAREST INTEGER FUNCTION) STAY LESS THAN 2**NBITS. -C - ISCALE=NINT(ALOG(BIGDIF/(2.**NBITS-0.5))/ALOG2+HPEPS) -C -C FORM DIFFERENCES, RESCALE, AND CONVERT TO INTEGER FORMAT. -C - TWON = 2.0 ** (-ISCALE) - DO 2000 K = 1,NPTS - NWORK(K) = NINT( (FIELD(K) - RMIN) * TWON ) - 2000 CONTINUE -C -C PACK THE MAGNITUDES (RIGHTMOST NBITS OF EACH WORD). -C - KOFF = 0 - ISKIP = 0 -C -C USE NCAR ARRAY BIT PACKER SBYTES (GBYTES PACKAGE) -C - CALL SBYTESC(NPFLD,NWORK,KOFF,NBITS,ISKIP,NPTS) -C -C ADD 7 ZERO-BITS AT END OF PACKED DATA TO INSURE BYTE BOUNDARY. -C USE NCAR WORD BIT PACKER SBYTE -C - NOFF = NBITS * NPTS - CALL SBYTEC(NPFLD,KZERO,NOFF,7) -C -C DETERMINE BYTE LENGTH (LEN) OF PACKED FIELD (NPFLD). -C - LEN = (NOFF + 7) / 8 -C - 3000 CONTINUE - RETURN -C - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi63.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi63.f deleted file mode 100755 index 9647060713..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi63.f +++ /dev/null @@ -1,3918 +0,0 @@ - SUBROUTINE W3FI63(MSGA,KPDS,KGDS,KBMS,DATA,KPTR,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI63 UNPK GRIB FIELD TO GRIB GRID -C PRGMMR: FARLEY ORG: NMC421 DATE:94-11-22 -C -C ABSTRACT: UNPACK A GRIB (EDITION 1) FIELD TO THE EXACT GRID -C SPECIFIED IN THE GRIB MESSAGE, ISOLATE THE BIT MAP, AND MAKE -C THE VALUES OF THE PRODUCT DESCRIPTON SECTION (PDS) AND THE -C GRID DESCRIPTION SECTION (GDS) AVAILABLE IN RETURN ARRAYS. -C -C WHEN DECODING IS COMPLETED, DATA AT EACH GRID POINT HAS BEEN -C RETURNED IN THE UNITS SPECIFIED IN THE GRIB MANUAL. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 91-11-12 CAVANAUGH MODIFIED SIZE OF ECMWF GRIDS 5-8 -C 91-12-22 CAVANAUGH CORRECTED PROCESSING OF MERCATOR PROJECTIONS -C IN GRID DEFINITION SECTION (GDS) IN -C ROUTINE FI633 -C 92-08-05 CAVANAUGH CORRECTED MAXIMUM GRID SIZE TO ALLOW FOR -C ONE DEGREE BY ONE DEGREE GLOBAL GRIDS -C 92-08-27 CAVANAUGH CORRECTED TYPO ERROR, ADDED CODE TO COMPARE -C TOTAL BYTE SIZE FROM SECTION 0 WITH SUM OF -C SECTION SIZES. -C 92-10-21 CAVANAUGH CORRECTIONS WERE MADE (IN FI634) TO REDUCE -C PROCESSING TIME FOR INTERNATIONAL GRIDS. -C REMOVED A TYPOGRAPHICAL ERROR IN FI635. -C 93-01-07 CAVANAUGH CORRECTIONS WERE MADE (IN FI635) TO -C FACILITATE USE OF THESE ROUTINES ON A PC. -C A TYPOGRAPHICAL ERROR WAS ALSO CORRECTED -C 93-01-13 CAVANAUGH CORRECTIONS WERE MADE (IN FI632) TO -C PROPERLY HANDLE CONDITION WHEN -C TIME RANGE INDICATOR = 10. -C ADDED U.S.GRID 87. -C 93-02-04 CAVANAUGH ADDED U.S.GRIDS 85 AND 86 -C 93-02-26 CAVANAUGH ADDED GRIDS 2, 3, 37 THRU 44,AND -C GRIDS 55, 56, 90, 91, 92, AND 93 TO -C LIST OF U.S. GRIDS. -C 93-04-07 CAVANAUGH ADDED GRIDS 67 THRU 77 TO -C LIST OF U.S. GRIDS. -C 93-04-20 CAVANAUGH INCREASED MAX SIZE TO ACCOMODATE -C GAUSSIAN GRIDS. -C 93-05-26 CAVANAUGH CORRECTED GRID RANGE SELECTION IN FI634 -C FOR RANGES 67-71 & 75-77 -C 93-06-08 CAVANAUGH CORRECTED FI635 TO ACCEPT GRIB MESSAGES -C WITH SECOND ORDER PACKING. ADDED ROUTINE FI636 -C TO PROCESS MESSAGES WITH SECOND ORDER PACKING. -C 93-09-22 CAVANAUGH MODIFIED TO EXTRACT SUB-CENTER NUMBER FROM -C PDS BYTE 26 -C 93-10-13 CAVANAUGH MODIFIED FI634 TO CORRECT GRID SIZES FOR -C GRIDS 204 AND 208 -C 93-10-14 CAVANAUGH INCREASED SIZE OF KGDS TO INCLUDE ENTRIES FOR -C NUMBER OF POINTS IN GRID AND NUMBER OF WORDS -C IN EACH ROW -C 93-12-08 CAVANAUGH CORRECTED TEST FOR EDITION NUMBER INSTEAD -C OF VERSION NUMBER -C 93-12-15 CAVANAUGH MODIFIED SECOND ORDER POINTERS TO FIRST ORDER -C VALUES AND SECOND ORDER VALUES CORRECTLY -C IN ROUTINE FI636 -C 94-03-02 CAVANAUGH ADDED CALL TO W3FI83 WITHIN DECODER. USER -C NO LONGER NEEDS TO MAKE CALL TO THIS ROUTINE -C 94-04-22 CAVANAUGH MODIFIED FI635, FI636 TO PROCESS ROW BY ROW -C SECOND ORDER PACKING, ADDED SCALING CORRECTION -C TO FI635, AND CORRECTED TYPOGRAPHICAL ERRORS -C IN COMMENT FIELDS IN FI634 -C 94-05-17 CAVANAUGH CORRECTED ERROR IN FI633 TO EXTRACT RESOLUTION -C FOR LAMBERT-CONFORMAL GRIDS. ADDED CLARIFYING -C INFORMATION TO DOCBLOCK ENTRIES -C 94-05-25 CAVANAUGH ADDED CODE TO PROCESS COLUMN BY COLUMN AS WELL -C AS ROW BY ROW ORDERING OF SECOND ORDER DATA -C 94-06-27 CAVANAUGH ADDED PROCESSING FOR GRIDS 45, 94 AND 95. -C INCLUDES CONSTRUCTION OF SECOND ORDER BIT MAPS -C FOR THINNED GRIDS IN FI636. -C 94-07-08 CAVANAUGH COMMENTED OUT PRINT OUTS USED FOR DEBUGGING -C 94-09-08 CAVANAUGH ADDED GRIDS 220, 221, 223 FOR FNOC -C 94-11-10 FARLEY INCREASED MXSIZE FROM 72960 TO 260000 -C FOR .5 DEGREE SST ANALYSIS FIELDS -C 94-12-06 R.E.JONES CHANGES IN FI632 FOR PDS GREATER THAN 28 -C 95-02-14 R.E.JONES CORRECT IN FI633 FOR NAVY WAFS GRIB -C 95-03-20 M.BALDWIN FI633 MODIFICATION TO GET -C DATA REP TYPES [KGDS(1)] 201 AND 202 TO WORK. -C 95-04-10 E.ROGERS ADDED GRIDS 96 AND 97 FOR ETA MODEL IN FI634. -C 95-04-26 R.E.JONES FI636 CORECTION FOR 2ND ORDER COMPLEX -C UNPACKING. R -C 95-05-19 R.E.JONES ADDED GRID 215, 20 KM AWIPS GRID -C 95-07-06 R.E.JONES ADDED GAUSSIAN T62, T126 GRID 98, 126 -C 95-10-19 R.E.JONES ADDED GRID 216, 45 KM ETA AWIPS ALASKA GRID -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 96-03-07 R.E.JONES CONTINUE UNPACK WITH KRET ERROR 9 IN FI631. -C 96-08-19 R.E.JONES ADDED MERCATOR GRIDS 8 AND 53, AND GRID 196 -C 97-02-12 W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING -C 98-06-17 IREDELL REMOVED ALTERNATE RETURN IN FI637 -C 98-08-31 IREDELL ELIMINATED NEED FOR MXSIZE -C 98-09-02 Gilbert Corrected error in map size for U.S. Grid 92 -C 98-09-08 BALDWIN ADD DATA REP TYPE [KGDS(1)] 203 -C 01-03-08 ROGERS CHANGED ETA GRIDS 90-97, ADDED ETA GRIDS -C 194, 198. ADDED AWIPS GRIDS 241,242,243, -C 245, 246, 247, 248, AND 250 -C 01-03-19 VUONG ADDED AWIPS GRIDS 238,239,240, AND 244 -C 2001-06-06 GILBERT CHanged gbyte/sbyte calls to refer to -C Wesley Ebisuzaki's endian independent -C versions gbytec/sbytec. -C Removed equivalences. -C 01-05-03 ROGERS ADDED GRID 249 (12KM FOR ALASKA) -C 01-10-10 ROGERS REDEFINED GRID 218 FOR 12 KM ETA -C REDEFINED GRID 192 FOR NEW 32-KM ETA GRID -C 02-03-27 VUONG ADDED RSAS GRID 88 AND AWIPS GRIDS 219, 220, -C 223, 224, 225, 226, 227, 228, 229, 230, 231, -C 232, 233, 234, 235, 251, AND 252 -C 02-08-06 ROGERS REDEFINED GRIDS 90-93,97,194,245-250 FOR THE -C 8KM HI-RES-WINDOW MODEL AND ADD AWIPS GRID 253 -C 2003-06-30 GILBERT SET NEW VALUES IN ARRAY KPTR TO PASS BACK ADDITIONAL -C PACKING INFO. -C KPTR(19) - BINARY SCALE FACTOR -C KPTR(20) - NUM BITS USED TO PACK EACH DATUM -C 2003-06-30 GILBERT ADDED GRIDS 145 and 146 for CMAQ -C and GRID 175 for AWIPS over GUAM. -C 2003-07-08 VUONG ADDED GRIDS 110, 127, 171, 172 AND MODIFIED GRID 170 -C 2004-09-02 VUONG ADDED AWIPS GRIDS 147, 148, 173 AND 254 -C 2005-01-04 COOKE ADDED AWIPS GRIDS 160 AND 161 -C 2005-03-03 VUONG MOVED GRID 170 TO GRID 174 AND ADD GRID 170 -C 2005-03-21 VUONG ADDED AWIPS GRID 130 -C 2005-10-11 VUONG ADDED AWIPS GRID 163 -C 2006-12-12 VUONG ADDED AWIPS GRID 120 -C 2007-04-12 VUONG ADDED AWIPS 176 AND DATA REP TYPE KGDS(1) 204 -C 2007-06-11 VUONG ADDED NEW GRIDS 11 TO 18 AND 122 TO 125 AND 138 -C AND 180 TO 183 -C 2007-11-06 VUONG CHANGED GRID 198 FROM ARAKAWA STAGGERED E-GRID TO POLAR -C STEREOGRAPGIC GRID ADDED NEW GRID 10, 99, 150, 151, 197 -C 2008-01-17 VUONG ADDED NEW GRID 195 AND CHANGED GRID 196 (ARAKAWA-E TO MERCATOR) -C -C USAGE: CALL W3FI63(MSGA,KPDS,KGDS,KBMS,DATA,KPTR,KRET) -C INPUT ARGUMENT LIST: -C MSGA - GRIB FIELD - "GRIB" THRU "7777" CHAR*1 -C (MESSAGE CAN BE PRECEDED BY JUNK CHARS) -C -C OUTPUT ARGUMENT LIST: -C DATA - ARRAY CONTAINING DATA ELEMENTS -C KPDS - ARRAY CONTAINING PDS ELEMENTS. (EDITION 1) -C (1) - ID OF CENTER -C (2) - GENERATING PROCESS ID NUMBER -C (3) - GRID DEFINITION -C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8) -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR INCLUDING (CENTURY-1) -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - VERSION NR OF GRIB SPECIFICATION -C (19) - VERSION NR OF PARAMETER TABLE -C (20) - NR MISSING FROM AVERAGE/ACCUMULATION -C (21) - CENTURY OF REFERENCE TIME OF DATA -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER NUMBER -C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS -C 128 IF FORECAST FIELD ERROR -C 64 IF BIAS CORRECTED FCST FIELD -C 32 IF SMOOTHED FIELD -C WARNING: CAN BE COMBINATION OF MORE THAN 1 -C (25) - PDS BYTE 30, NOT USED -C (26-35) - RESERVED -C (36-N) - CONSECUTIVE BYTES EXTRACTED FROM PROGRAM -C DEFINITION SECTION (PDS) OF GRIB MESSAGE -C KGDS - ARRAY CONTAINING GDS ELEMENTS. -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C GAUSSIAN GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - N - NR OF CIRCLES POLE TO EQUATOR -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - NV - NR OF VERT COORD PARAMETERS -C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS -C OR -C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN -C EACH ROW (IF NO VERT COORD PARAMETERS -C ARE PRESENT -C OR -C 255 IF NEITHER ARE PRESENT -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28) -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C STAGGERED ARAKAWA ROTATED LAT/LON GRIDS (TYPE 203) -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - LA(2) LATITUDE OF CENTER -C (8) - LO(2) LONGITUDE OF CENTER -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C CURVILINEAR ORTHIGINAL GRID (TYPE 204) -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - RESERVED SET TO 0 -C (5) - RESERVED SET TO 0 -C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17) -C (7) - RESERVED SET TO 0 -C (8) - RESERVED SET TO 0 -C (9) - RESERVED SET TO 0 -C (10) - RESERVED SET TO 0 -C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28) -C KBMS - BITMAP DESCRIBING LOCATION OF OUTPUT ELEMENTS. -C (ALWAYS CONSTRUCTED) -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG (COPY OF BMS OCTETS 5,6) -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS (RIGHT ADJ COPY OF OCTET 4) -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C (16) - RESERVED -C (17) - RESERVED -C (18) - RESERVED -C (19) - BINARY SCALE FACTOR -C (20) - NUM BITS USED TO PACK EACH DATUM -C KRET - FLAG INDICATING QUALITY OF COMPLETION -C -C REMARKS: WHEN DECODING IS COMPLETED, DATA AT EACH GRID POINT HAS BEEN -C RETURNED IN THE UNITS SPECIFIED IN THE GRIB MANUAL. -C -C VALUES FOR RETURN FLAG (KRET) -C KRET = 0 - NORMAL RETURN, NO ERRORS -C = 1 - 'GRIB' NOT FOUND IN FIRST 100 CHARS -C = 2 - '7777' NOT IN CORRECT LOCATION -C = 3 - UNPACKED FIELD IS LARGER THAN 260000 -C = 4 - GDS/ GRID NOT ONE OF CURRENTLY ACCEPTED VALUES -C = 5 - GRID NOT CURRENTLY AVAIL FOR CENTER INDICATED -C = 8 - TEMP GDS INDICATED, BUT GDS FLAG IS OFF -C = 9 - GDS INDICATES SIZE MISMATCH WITH STD GRID -C =10 - INCORRECT CENTER INDICATOR -C =11 - BINARY DATA SECTION (BDS) NOT COMPLETELY PROCESSED. -C PROGRAM IS NOT SET TO PROCESS FLAG COMBINATIONS -C SHOWN IN OCTETS 4 AND 14. -C =12 - BINARY DATA SECTION (BDS) NOT COMPLETELY PROCESSED. -C PROGRAM IS NOT SET TO PROCESS FLAG COMBINATIONS -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ -C 4 AUG 1988 -C W3FI63 -C -C -C GRIB UNPACKING ROUTINE -C -C -C THIS ROUTINE WILL UNPACK A 'GRIB' FIELD TO THE EXACT GRID -C TYPE SPECIFIED IN THE MESSAGE, RETURN A BIT MAP AND MAKE THE -C VALUES OF THE PRODUCT DEFINITION SEC (PDS) AND THE GRID -C DESCRIPTION SEC (GDS) AVAILABLE IN RETURN ARRAYS. -C SEE "GRIB - THE WMO FORMAT FOR THE STORAGE OF WEATHER PRODUCT -C INFORMATION AND THE EXCHANGE OF WEATHER PRODUCT MESSAGES IN -C GRIDDED BINARY FORM" DATED JULY 1, 1988 BY JOHN D. STACKPOLE -C DOC, NOAA, NWS, NATIONAL METEOROLOGICAL CENTER. -C -C THE CALL TO THE GRIB UNPACKING ROUTINE IS AS FOLLOWS: -C -C CALL W3FI63(MSGA,KPDS,KGDS,LBMS,DATA,KPTR,KRET) -C -C INPUT: -C -C MSGA = CONTAINS THE GRIB MESSAGE TO BE UNPACKED. CHARACTERS -C "GRIB" MAY BEGIN ANYWHERE WITHIN FIRST 100 BYTES. -C -C OUTPUT: -C -C KPDS(100) INTEGER*4 -C ARRAY TO CONTAIN THE ELEMENTS OF THE PRODUCT -C DEFINITION SEC . -C (VERSION 1) -C KPDS(1) - ID OF CENTER -C KPDS(2) - MODEL IDENTIFICATION (SEE "GRIB" TABLE 1) -C KPDS(3) - GRID IDENTIFICATION (SEE "GRIB" TABLE 2) -C KPDS(4) - GDS/BMS FLAG -C BIT DEFINITION -C 25 0 - GDS OMITTED -C 1 - GDS INCLUDED -C 26 0 - BMS OMITTED -C 1 - BMS INCLUDED -C NOTE:- LEFTMOST BIT = 1, -C RIGHTMOST BIT = 32 -C KPDS(5) - INDICATOR OF PARAMETER (SEE "GRIB" TABLE 5) -C KPDS(6) - TYPE OF LEVEL (SEE "GRIB" TABLES 6 & 7) -C KPDS(7) - HEIGHT,PRESSURE,ETC OF LEVEL -C KPDS(8) - YEAR INCLUDING CENTURY -C KPDS(9) - MONTH OF YEAR -C KPDS(10) - DAY OF MONTH -C KPDS(11) - HOUR OF DAY -C KPDS(12) - MINUTE OF HOUR -C KPDS(13) - INDICATOR OF FORECAST TIME UNIT (SEE "GRIB" -C TABLE 8) -C KPDS(14) - TIME 1 (SEE "GRIB" TABLE 8A) -C KPDS(15) - TIME 2 (SEE "GRIB" TABLE 8A) -C KPDS(16) - TIME RANGE INDICATOR (SEE "GRIB" TABLE 8A) -C KPDS(17) - NUMBER INCLUDED IN AVERAGE -C KPDS(18) - EDITION NR OF GRIB SPECIFICATION -C KPDS(19) - VERSION NR OF PARAMETER TABLE -C -C KGDS(13) INTEGER*4 -C ARRAY CONTAINING GDS ELEMENTS. -C -C KGDS(1) - DATA REPRESENTATION TYPE -C -C LATITUDE/LONGITUDE GRIDS (SEE "GRIB" TABLE 10) -C KGDS(2) - N(I) NUMBER OF POINTS ON LATITUDE -C CIRCLE -C KGDS(3) - N(J) NUMBER OF POINTS ON LONGITUDE -C CIRCLE -C KGDS(4) - LA(1) LATITUDE OF ORIGIN -C KGDS(5) - LO(1) LONGITUDE OF ORIGIN -C KGDS(6) - RESOLUTION FLAG -C BIT MEANING -C 25 0 - DIRECTION INCREMENTS NOT -C GIVEN -C 1 - DIRECTION INCREMENTS GIVEN -C KGDS(7) - LA(2) LATITUDE OF EXTREME POINT -C KGDS(8) - LO(2) LONGITUDE OF EXTREME POINT -C KGDS(9) - DI LONGITUDINAL DIRECTION INCREMENT -C KGDS(10) - REGULAR LAT/LON GRID -C DJ - LATITUDINAL DIRECTION -C INCREMENT -C GAUSSIAN GRID -C N - NUMBER OF LATITUDE CIRCLES -C BETWEEN A POLE AND THE EQUATOR -C KGDS(11) - SCANNING MODE FLAG -C BIT MEANING -C 25 0 - POINTS ALONG A LATITUDE -C SCAN FROM WEST TO EAST -C 1 - POINTS ALONG A LATITUDE -C SCAN FROM EAST TO WEST -C 26 0 - POINTS ALONG A MERIDIAN -C SCAN FROM NORTH TO SOUTH -C 1 - POINTS ALONG A MERIDIAN -C SCAN FROM SOUTH TO NORTH -C 27 0 - POINTS SCAN FIRST ALONG -C CIRCLES OF LATITUDE, THEN -C ALONG MERIDIANS -C (FORTRAN: (I,J)) -C 1 - POINTS SCAN FIRST ALONG -C MERIDIANS THEN ALONG -C CIRCLES OF LATITUDE -C (FORTRAN: (J,I)) -C -C POLAR STEREOGRAPHIC GRIDS (SEE GRIB TABLE 12) -C KGDS(2) - N(I) NR POINTS ALONG LAT CIRCLE -C KGDS(3) - N(J) NR POINTS ALONG LON CIRCLE -C KGDS(4) - LA(1) LATITUDE OF ORIGIN -C KGDS(5) - LO(1) LONGITUDE OF ORIGIN -C KGDS(6) - RESERVED -C KGDS(7) - LOV GRID ORIENTATION -C KGDS(8) - DX - X DIRECTION INCREMENT -C KGDS(9) - DY - Y DIRECTION INCREMENT -C KGDS(10) - PROJECTION CENTER FLAG -C KGDS(11) - SCANNING MODE -C -C SPHERICAL HARMONIC COEFFICIENTS (SEE "GRIB" TABLE 14) -C KGDS(2) - J PENTAGONAL RESOLUTION PARAMETER -C KGDS(3) - K PENTAGONAL RESOLUTION PARAMETER -C KGDS(4) - M PENTAGONAL RESOLUTION PARAMETER -C KGDS(5) - REPRESENTATION TYPE -C KGDS(6) - COEFFICIENT STORAGE MODE -C -C MERCATOR GRIDS -C KGDS(2) - N(I) NR POINTS ON LATITUDE CIRCLE -C KGDS(3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C KGDS(4) - LA(1) LATITUDE OF ORIGIN -C KGDS(5) - LO(1) LONGITUDE OF ORIGIN -C KGDS(6) - RESOLUTION FLAG -C KGDS(7) - LA(2) LATITUDE OF LAST GRID POINT -C KGDS(8) - LO(2) LONGITUDE OF LAST GRID POINT -C KGDS(9) - LATIN - LATITUDE OF PROJECTION INTERSECTION -C KGDS(10) - RESERVED -C KGDS(11) - SCANNING MODE FLAG -C KGDS(12) - LONGITUDINAL DIR GRID LENGTH -C KGDS(13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C KGDS(2) - NX NR POINTS ALONG X-AXIS -C KGDS(3) - NY NR POINTS ALONG Y-AXIS -C KGDS(4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C KGDS(5) - LO1 LON OF ORIGIN (LOWER LEFT) -C KGDS(6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C KGDS(7) - LOV - ORIENTATION OF GRID -C KGDS(8) - DX - X-DIR INCREMENT -C KGDS(9) - DY - Y-DIR INCREMENT -C KGDS(10) - PROJECTION CENTER FLAG -C KGDS(11) - SCANNING MODE FLAG -C KGDS(12) - LATIN 1 - FIRST LAT FROM POLE OF -C SECANT CONE INTERSECTION -C KGDS(13) - LATIN 2 - SECOND LAT FROM POLE OF -C SECANT CONE INTERSECTION -C -C LBMS(*) LOGICAL -C ARRAY TO CONTAIN THE BIT MAP DESCRIBING THE -C PLACEMENT OF DATA IN THE OUTPUT ARRAY. IF A -C BIT MAP IS NOT INCLUDED IN THE SOURCE MESSAGE, -C ONE WILL BE GENERATED AUTOMATICALLY BY THE -C UNPACKING ROUTINE. -C -C -C DATA(*) REAL*4 -C THIS ARRAY WILL CONTAIN THE UNPACKED DATA POINTS. -C -C NOTE:- 65160 IS MAXIMUN FIELD SIZE ALLOWABLE -C -C KPTR(10) INTEGER*4 -C ARRAY CONTAINING STORAGE FOR THE FOLLOWING -C PARAMETERS. -C -C (1) - UNUSED -C (2) - UNUSED -C (3) - LENGTH OF PDS (IN BYTES) -C (4) - LENGTH OF GDS (IN BYTES) -C (5) - LENGTH OF BMS (IN BYTES) -C (6) - LENGTH OF BDS (IN BYTES) -C (7) - USED BY UNPACKING ROUTINE -C (8) - NUMBER OF DATA POINTS FOR GRID -C (9) - "GRIB" CHARACTERS START IN BYTE NUMBER -C (10) - USED BY UNPACKING ROUTINE -C -C -C KRET INTEGER*4 -C THIS VARIABLE WILL CONTAIN THE RETURN INDICATOR. -C -C 0 - NO ERRORS DETECTED. -C -C 1 - 'GRIB' NOT FOUND IN FIRST 100 -C CHARACTERS. -C -C 2 - '7777' NOT FOUND, EITHER MISSING OR -C TOTAL OF SEC COUNTS OF INDIVIDUAL -C SECTIONS IS INCORRECT. -C -C 3 - UNPACKED FIELD IS LARGER THAN 65160. -C -C 4 - IN GDS, DATA REPRESENTATION TYPE -C NOT ONE OF THE CURRENTLY ACCEPTABLE -C VALUES. SEE "GRIB" TABLE 9. VALUE -C OF INCORRECT TYPE RETURNED IN KGDS(1). -C -C 5 - GRID INDICATED IN KPDS(3) IS NOT -C AVAILABLE FOR THE CENTER INDICATED IN -C KPDS(1) AND NO GDS SENT. -C -C 7 - EDITION INDICATED IN KPDS(18) HAS NOT -C YET BEEN INCLUDED IN THE DECODER. -C -C 8 - GRID IDENTIFICATION = 255 (NOT STANDARD -C GRID) BUT FLAG INDICATING PRESENCE OF -C GDS IS TURNED OFF. NO METHOD OF -C GENERATING PROPER GRID. -C -C 9 - PRODUCT OF KGDS(2) AND KGDS(3) DOES NOT -C MATCH STANDARD NUMBER OF POINTS FOR THIS -C GRID (FOR OTHER THAN SPECTRALS). THIS -C WILL OCCUR ONLY IF THE GRID. -C IDENTIFICATION, KPDS(3), AND A -C TRANSMITTED GDS ARE INCONSISTENT. -C -C 10 - CENTER INDICATOR WAS NOT ONE INDICATED -C IN "GRIB" TABLE 1. PLEASE CONTACT AD -C PRODUCTION MANAGEMENT BRANCH (W/NMC42) -C IF THIS ERROR IS ENCOUNTERED. -C -C 11 - BINARY DATA SECTION (BDS) NOT COMPLETELY -C PROCESSED. PROGRAM IS NOT SET TO PROCESS -C FLAG COMBINATIONS AS SHOWN IN -C OCTETS 4 AND 14. -C -C -C LIST OF TEXT MESSAGES FROM CODE -C -C -C W3FI63/FI632 -C -C 'HAVE ENCOUNTERED A NEW GRID FOR NMC, PLEASE NOTIFY -C AUTOMATION DIVISION, PRODUCTION MANAGEMENT BRANCH -C (W/NMC42)' -C -C 'HAVE ENCOUNTERED A NEW GRID FOR ECMWF, PLEASE NOTIFY -C AUTOMATION DIVISION, PRODUCTION MANAGEMENT BRANCH -C (W/NMC42)' -C -C 'HAVE ENCOUNTERED A NEW GRID FOR U.K. METEOROLOGICAL -C OFFICE, BRACKNELL. PLEASE NOTIFY AUTOMATION DIVISION, -C PRODUCTION MANAGEMENT BRANCH (W/NMC42)' -C -C 'HAVE ENCOUNTERED A NEW GRID FOR FNOC, PLEASE NOTIFY -C AUTOMATION DIVISION, PRODUCTION MANAGEMENT BRANCH -C (W/NMC42)' -C -C -C W3FI63/FI633 -C -C 'POLAR STEREO PROCESSING NOT AVAILABLE' * -C -C W3FI63/FI634 -C -C 'WARNING - BIT MAP MAY NOT BE ASSOCIATED WITH SPHERICAL -C COEFFICIENTS' -C -C -C W3FI63/FI637 -C -C 'NO CURRENT LISTING OF FNOC GRIDS' * -C -C -C * WILL BE AVAILABLE IN NEXT UPDATE -C *************************************************************** -C -C INCOMING MESSAGE HOLDER - CHARACTER*1 MSGA(*) -C BIT MAP - LOGICAL*1 KBMS(*) -C -C ELEMENTS OF PRODUCT DESCRIPTION SEC (PDS) - INTEGER KPDS(*) -C ELEMENTS OF GRID DESCRIPTION SEC (PDS) - INTEGER KGDS(*) -C -C CONTAINER FOR GRIB GRID - REAL DATA(*) -C -C ARRAY OF POINTERS AND COUNTERS - INTEGER KPTR(*) -C -C ***************************************************************** - INTEGER JSGN,JEXP,IFR,NPTS - REAL REALKK,FVAL1,FDIFF1 -C ***************************************************************** -C 1.0 LOCATE BEGINNING OF 'GRIB' MESSAGE -C FIND 'GRIB' CHARACTERS -C 2.0 USE COUNTS IN EACH DESCRIPTION SEC TO DETERMINE -C IF '7777' IS IN PROPER PLACE. -C 3.0 PARSE PRODUCT DEFINITION SECTION. -C 4.0 PARSE GRID DESCRIPTION SEC (IF INCLUDED) -C 5.0 PARSE BIT MAP SEC (IF INCLUDED) -C 6.0 USING INFORMATION FROM PRODUCT DEFINITION, GRID -C DESCRIPTION, AND BIT MAP SECTIONS.. EXTRACT -C DATA AND PLACE INTO PROPER ARRAY. -C ******************************************************************* -C -C MAIN DRIVER -C -C ******************************************************************* - KPTR(10) = 0 -C SEE IF PROPER 'GRIB' KEY EXISTS, THEN -C USING SEC COUNTS, DETERMINE IF '7777' -C IS IN THE PROPER LOCATION -C - CALL FI631(MSGA,KPTR,KPDS,KRET) - IF(KRET.NE.0) THEN - GO TO 900 - END IF -C PRINT *,'FI631 KPTR',(KPTR(I),I=1,16) -C -C PARSE PARAMETERS FROM PRODUCT DESCRIPTION SECTION -C - CALL FI632(MSGA,KPTR,KPDS,KRET) - IF(KRET.NE.0) THEN - GO TO 900 - END IF -C PRINT *,'FI632 KPTR',(KPTR(I),I=1,16) -C -C IF AVAILABLE, EXTRACT NEW GRID DESCRIPTION -C - IF (IAND(KPDS(4),128).NE.0) THEN - CALL FI633(MSGA,KPTR,KGDS,KRET) - IF(KRET.NE.0) THEN - GO TO 900 - END IF -C PRINT *,'FI633 KPTR',(KPTR(I),I=1,16) - END IF -C -C EXTRACT OR GENERATE BIT MAP -C - CALL FI634(MSGA,KPTR,KPDS,KGDS,KBMS,KRET) - IF (KRET.NE.0) THEN - IF (KRET.NE.9) THEN - GO TO 900 - END IF - END IF -C PRINT *,'FI634 KPTR',(KPTR(I),I=1,16) -C -C USING INFORMATION FROM PDS, BMS AND BIT DATA SEC , -C EXTRACT AND SAVE IN GRIB GRID, ALL DATA ENTRIES. -C - IF (KPDS(18).EQ.1) THEN - CALL FI635(MSGA,KPTR,KPDS,KGDS,KBMS,DATA,KRET) - IF (KPTR(3).EQ.50) THEN -C -C PDS EQUAL 50 BYTES -C THEREFORE SOMETHING SPECIAL IS GOING ON -C -C IN THIS CASE 2ND DIFFERENCE PACKING -C NEEDS TO BE UNDONE. -C -C EXTRACT FIRST VALUE FROM BYTE 41-44 PDS -C KPTR(9) CONTAINS OFFSET TO START OF -C GRIB MESSAGE. -C EXTRACT FIRST FIRST-DIFFERENCE FROM BYTES 45-48 PDS -C -C AND EXTRACT SCALE FACTOR (E) TO UNDO 2**E -C THAT WAS APPLIED PRIOR TO 2ND ORDER PACKING -C AND PLACED IN PDS BYTES 49-51 -C FACTOR IS A SIGNED TWO BYTE INTEGER -C -C ALSO NEED THE DECIMAL SCALING FROM PDS(27-28) -C (AVAILABLE IN KPDS(22) FROM UNPACKER) -C TO UNDO THE DECIMAL SCALING APPLIED TO THE -C SECOND DIFFERENCES DURING UNPACKING. -C SECOND DIFFS ALWAYS PACKED WITH 0 DECIMAL SCALE -C BUT UNPACKER DOESNT KNOW THAT. -C -C CALL GBYTE (MSGA,FVAL1,KPTR(9)+384,32) -C -C NOTE INTEGERS, CHARACTERS AND EQUIVALENCES -C DEFINED ABOVE TO MAKE THIS KKK EXTRACTION -C WORK AND LINE UP ON WORD BOUNDARIES -C -C THE NEXT CODE WILL CONVERT THE IBM370 FOATING POINT -C TO THE FLOATING POINT USED ON YOUR MACHINE. -C - call gbytec(MSGA,JSGN,KPTR(9)+384,1) - call gbytec(MSGA,JEXP,KPTR(9)+385,7) - call gbytec(MSGA,IFR,KPTR(9)+392,24) -C - IF (IFR.EQ.0) THEN - REALKK = 0.0 - ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN - REALKK = 0.0 - ELSE - REALKK = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) - IF (JSGN.NE.0) REALKK = -REALKK - END IF - FVAL1 = REALKK -C -C CALL GBYTE (MSGA,FDIFF1,KPTR(9)+416,32) -C (REPLACED BY FOLLOWING EXTRACTION) -C -C THE NEXT CODE WILL CONVERT THE IBM370 FOATING POINT -C TO THE FLOATING POINT USED ON YOUR MACHINE. -C - call gbytec(MSGA,JSGN,KPTR(9)+416,1) - call gbytec(MSGA,JEXP,KPTR(9)+417,7) - call gbytec(MSGA,IFR,KPTR(9)+424,24) -C - IF (IFR.EQ.0) THEN - REALKK = 0.0 - ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN - REALKK = 0.0 - ELSE - REALKK = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) - IF (JSGN.NE.0) REALKK = -REALKK - END IF - FDIFF1 = REALKK -C - CALL GBYTEC (MSGA,ISIGN,KPTR(9)+448,1) - CALL GBYTEC (MSGA,ISCAL2,KPTR(9)+449,15) - IF(ISIGN.GT.0) THEN - ISCAL2 = - ISCAL2 - ENDIF -C PRINT *,'DELTA POINT 1-',FVAL1 -C PRINT *,'DELTA POINT 2-',FDIFF1 -C PRINT *,'DELTA POINT 3-',ISCAL2 - NPTS = KPTR(10) -C WRITE (6,FMT='('' 2ND DIFF POINTS IN FIELD = '',/, -C & 10(3X,10F12.2,/))') (DATA(I),I=1,NPTS) -C PRINT *,'DELTA POINT 4-',KPDS(22) - CALL W3FI83 (DATA,NPTS,FVAL1,FDIFF1, - & ISCAL2,KPDS(22),KPDS,KGDS) -C WRITE (6,FMT='('' 2ND DIFF EXPANDED POINTS IN FIELD = '', -C & /,10(3X,10F12.2,/))') (DATA(I),I=1,NPTS) -C WRITE (6,FMT='('' END OF ARRAY IN FIELD = '',/, -C & 10(3X,10F12.2,/))') (DATA(I),I=NPTS-5,NPTS) - END IF - ELSE -C PRINT *,'FI635 NOT PROGRAMMED FOR EDITION NR',KPDS(18) - KRET = 7 - END IF -C - 900 RETURN - END - SUBROUTINE FI631(MSGA,KPTR,KPDS,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI631 FIND 'GRIB' CHARS & RESET POINTERS -C PRGMMR: BILL CAVANAUGH ORG: W/NMC42 DATE: 91-09-13 -C -C ABSTRACT: FIND 'GRIB; CHARACTERS AND SET POINTERS TO THE NEXT -C BYTE FOLLOWING 'GRIB'. IF THEY EXIST EXTRACT COUNTS FROM GDS AND -C BMS. EXTRACT COUNT FROM BDS. DETERMINE IF SUM OF COUNTS ACTUALLY -C PLACES TERMINATOR '7777' AT THE CORRECT LOCATION. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI631(MSGA,KPTR,KPDS,KRET) -C INPUT ARGUMENT LIST: -C MSGA - GRIB FIELD - "GRIB" THRU "7777" -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C KPDS - ARRAY CONTAINING PDS ELEMENTS. -C (1) - ID OF CENTER -C (2) - MODEL IDENTIFICATION -C (3) - GRID IDENTIFICATION -C (4) - GDS/BMS FLAG -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR OF CENTURY -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C KPTR - SEE INPUT LIST -C KRET - ERROR RETURN -C -C REMARKS: -C ERROR RETURNS -C KRET = 1 - NO 'GRIB' -C 2 - NO '7777' OR MISLOCATED (BY COUNTS) -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS9000 -C -C$$$ -C -C INCOMING MESSAGE HOLDER - CHARACTER*1 MSGA(*) -C ARRAY OF POINTERS AND COUNTERS - INTEGER KPTR(*) -C PRODUCT DESCRIPTION SECTION DATA. - INTEGER KPDS(*) -C - INTEGER KRET -C -C ****************************************************************** - KRET = 0 -C ------------------- FIND 'GRIB' KEY - DO 50 I = 0, 839, 8 - CALL GBYTEC (MSGA,MGRIB,I,32) - IF (MGRIB.EQ.1196575042) THEN - KPTR(9) = I - GO TO 60 - END IF - 50 CONTINUE - KRET = 1 - RETURN - 60 CONTINUE -C -------------FOUND 'GRIB' -C SKIP GRIB CHARACTERS -C PRINT *,'FI631 GRIB AT',I - KPTR(8) = KPTR(9) + 32 - CALL GBYTEC (MSGA,ITOTAL,KPTR(8),24) -C HAVE LIFTED WHAT MAY BE A MSG TOTAL BYTE COUNT - IPOINT = KPTR(9) + ITOTAL * 8 - 32 - CALL GBYTEC (MSGA,I7777,IPOINT,32) - IF (I7777.EQ.926365495) THEN -C HAVE FOUND END OF MESSAGE '7777' IN PROPER LOCATION -C MARK AND PROCESS AS GRIB VERSION 1 OR HIGHER -C PRINT *,'FI631 7777 AT',IPOINT - KPTR(8) = KPTR(8) + 24 - KPTR(1) = ITOTAL - KPTR(2) = 8 - CALL GBYTEC (MSGA,KPDS(18),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 - ELSE -C CANNOT FIND END OF GRIB EDITION 1 MESSAGE - KRET = 2 - RETURN - END IF -C ------------------- PROCESS SECTION 1 -C EXTRACT COUNT FROM PDS -C PRINT *,'START OF PDS',KPTR(8) - CALL GBYTEC (MSGA,KPTR(3),KPTR(8),24) - LOOK = KPTR(8) + 56 -C EXTRACT GDS/BMS FLAG - CALL GBYTEC (MSGA,KPDS(4),LOOK,8) - KPTR(8) = KPTR(8) + KPTR(3) * 8 -C PRINT *,'START OF GDS',KPTR(8) - IF (IAND(KPDS(4),128).NE.0) THEN -C EXTRACT COUNT FROM GDS - CALL GBYTEC (MSGA,KPTR(4),KPTR(8),24) - KPTR(8) = KPTR(8) + KPTR(4) * 8 - ELSE - KPTR(4) = 0 - END IF -C PRINT *,'START OF BMS',KPTR(8) - IF (IAND(KPDS(4),64).NE.0) THEN -C EXTRACT COUNT FROM BMS - CALL GBYTEC (MSGA,KPTR(5),KPTR(8),24) - ELSE - KPTR(5) = 0 - END IF - KPTR(8) = KPTR(8) + KPTR(5) * 8 -C PRINT *,'START OF BDS',KPTR(8) -C EXTRACT COUNT FROM BDS - CALL GBYTEC (MSGA,KPTR(6),KPTR(8),24) -C --------------- TEST FOR '7777' -C PRINT *,(KPTR(KJ),KJ=1,10) - KPTR(8) = KPTR(8) + KPTR(6) * 8 -C EXTRACT FOUR BYTES FROM THIS LOCATION -C PRINT *,'FI631 LOOKING FOR 7777 AT',KPTR(8) - CALL GBYTEC (MSGA,K7777,KPTR(8),32) - MATCH = KPTR(2) + KPTR(3) + KPTR(4) + KPTR(5) + KPTR(6) + 4 - IF (K7777.NE.926365495.OR.MATCH.NE.KPTR(1)) THEN - KRET = 2 - ELSE -C PRINT *,'FI631 7777 AT',KPTR(8) - IF (KPDS(18).EQ.0) THEN - KPTR(1) = KPTR(2) + KPTR(3) + KPTR(4) + KPTR(5) + - * KPTR(6) + 4 - END IF - END IF -C PRINT *,'KPTR',(KPTR(I),I=1,16) - RETURN - END - SUBROUTINE FI632(MSGA,KPTR,KPDS,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI632 GATHER INFO FROM PRODUCT DEFINITION SEC -C PRGMMR: BILL CAVANAUGH ORG: W/NMC42 DATE: 91-09-13 -C -C ABSTRACT: EXTRACT INFORMATION FROM THE PRODUCT DESCRIPTION -C SEC , AND GENERATE LABEL INFORMATION TO PERMIT STORAGE -C IN OFFICE NOTE 84 FORMAT. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 93-12-08 CAVANAUGH CORRECTED TEST FOR EDITION NUMBER INSTEAD -C OF VERSION NUMBER -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 99-01-20 BALDWIN MODIFIED TO HANDLE GRID 237 -C -C USAGE: CALL FI632(MSGA,KPTR,KPDS,KRET) -C INPUT ARGUMENT LIST: -C MSGA - ARRAY CONTAINING GRIB MESSAGE -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C KPDS - ARRAY CONTAINING PDS ELEMENTS. -C (1) - ID OF CENTER -C (2) - MODEL IDENTIFICATION -C (3) - GRID IDENTIFICATION -C (4) - GDS/BMS FLAG -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR OF CENTURY -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C (18) - -C (19) - -C (20) - NUMBER MISSING FROM AVGS/ACCUMULATIONS -C (21) - CENTURY -C (22) - UNITS DECIMAL SCALE FACTOR -C (23) - SUBCENTER -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C SEE INPUT LIST -C KRET - ERROR RETURN -C -C REMARKS: -C ERROR RETURN = 0 - NO ERRORS -C = 8 - TEMP GDS INDICATED, BUT NO GDS -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS9000 -C -C$$$ -C -C INCOMING MESSAGE HOLDER - CHARACTER*1 MSGA(*) -C -C ARRAY OF POINTERS AND COUNTERS - INTEGER KPTR(*) -C PRODUCT DESCRIPTION SECTION ENTRIES - INTEGER KPDS(*) -C - INTEGER KRET - KRET=0 -C ------------------- PROCESS SECTION 1 - KPTR(8) = KPTR(9) + KPTR(2) * 8 + 24 -C BYTE 4 -C PARAMETER TABLE VERSION NR - CALL GBYTEC (MSGA,KPDS(19),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 5 IDENTIFICATION OF CENTER - CALL GBYTEC (MSGA,KPDS(1),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 6 -C GET GENERATING PROCESS ID NR - CALL GBYTEC (MSGA,KPDS(2),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 7 -C GRID DEFINITION - CALL GBYTEC (MSGA,KPDS(3),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 8 -C GDS/BMS FLAGS -C CALL GBYTEC (MSGA,KPDS(4),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 9 -C INDICATOR OF PARAMETER - CALL GBYTEC (MSGA,KPDS(5),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 10 -C TYPE OF LEVEL - CALL GBYTEC (MSGA,KPDS(6),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 11,12 -C HEIGHT/PRESSURE - CALL GBYTEC (MSGA,KPDS(7),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C BYTE 13 -C YEAR OF CENTURY - CALL GBYTEC (MSGA,KPDS(8),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 14 -C MONTH OF YEAR - CALL GBYTEC (MSGA,KPDS(9),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 15 -C DAY OF MONTH - CALL GBYTEC (MSGA,KPDS(10),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 16 -C HOUR OF DAY - CALL GBYTEC (MSGA,KPDS(11),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 17 -C MINUTE - CALL GBYTEC (MSGA,KPDS(12),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 18 -C INDICATOR TIME UNIT RANGE - CALL GBYTEC (MSGA,KPDS(13),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 19 -C P1 - PERIOD OF TIME - CALL GBYTEC (MSGA,KPDS(14),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 20 -C P2 - PERIOD OF TIME - CALL GBYTEC (MSGA,KPDS(15),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 21 -C TIME RANGE INDICATOR - CALL GBYTEC (MSGA,KPDS(16),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C -C IF TIME RANGE INDICATOR IS 10, P1 IS PACKED IN -C PDS BYTES 19-20 -C - IF (KPDS(16).EQ.10) THEN - KPDS(14) = KPDS(14) * 256 + KPDS(15) - KPDS(15) = 0 - END IF -C BYTE 22,23 -C NUMBER INCLUDED IN AVERAGE - CALL GBYTEC (MSGA,KPDS(17),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C BYTE 24 -C NUMBER MISSING FROM AVERAGES/ACCUMULATIONS - CALL GBYTEC (MSGA,KPDS(20),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 25 -C IDENTIFICATION OF CENTURY - CALL GBYTEC (MSGA,KPDS(21),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 - IF (KPTR(3).GT.25) THEN -C BYTE 26 SUB CENTER NUMBER - CALL GBYTEC (MSGA,KPDS(23),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 - IF (KPTR(3).GE.28) THEN -C BYTE 27-28 -C UNITS DECIMAL SCALE FACTOR - CALL GBYTEC (MSGA,ISIGN,KPTR(8),1) - KPTR(8) = KPTR(8) + 1 - CALL GBYTEC (MSGA,IDEC,KPTR(8),15) - KPTR(8) = KPTR(8) + 15 - IF (ISIGN.GT.0) THEN - KPDS(22) = - IDEC - ELSE - KPDS(22) = IDEC - END IF - ISIZ = KPTR(3) - 28 - IF (ISIZ.LE.12) THEN -C BYTE 29 - CALL GBYTEC (MSGA,KPDS(24),KPTR(8)+8,8) -C BYTE 30 - CALL GBYTEC (MSGA,KPDS(25),KPTR(8)+16,8) -C BYTES 31-40 CURRENTLY RESERVED FOR FUTURE USE - KPTR(8) = KPTR(8) + ISIZ * 8 - ELSE -C BYTE 29 - CALL GBYTEC (MSGA,KPDS(24),KPTR(8)+8,8) -C BYTE 30 - CALL GBYTEC (MSGA,KPDS(25),KPTR(8)+16,8) -C BYTES 31-40 CURRENTLY RESERVED FOR FUTURE USE - KPTR(8) = KPTR(8) + 12 * 8 -C BYTES 41 - N LOCAL USE DATA - CALL W3FI01(LW) -C MWDBIT = LW * 8 - MWDBIT = bit_size(KPDS) - ISIZ = KPTR(3) - 40 - ITER = ISIZ / LW - IF (MOD(ISIZ,LW).NE.0) ITER = ITER + 1 - CALL GBYTESC (MSGA,KPDS(36),KPTR(8),MWDBIT,0,ITER) - KPTR(8) = KPTR(8) + ISIZ * 8 - END IF - END IF - END IF -C ----------- TEST FOR NEW GRID - IF (IAND(KPDS(4),128).NE.0) THEN - IF (IAND(KPDS(4),64).NE.0) THEN - IF (KPDS(3).NE.255) THEN - IF (KPDS(3).GE.21.AND.KPDS(3).LE.26)THEN - RETURN - ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44)THEN - RETURN - ELSE IF (KPDS(3).GE.61.AND.KPDS(3).LE.64) THEN - RETURN - END IF - IF (KPDS(1).EQ.7) THEN - IF (KPDS(3).GE.2.AND.KPDS(3).LE.3) THEN - ELSE IF (KPDS(3).GE.5.AND.KPDS(3).LE.6) THEN - ELSE IF (KPDS(3).EQ.8) THEN - ELSE IF (KPDS(3).EQ.10) THEN - ELSE IF (KPDS(3).GE.27.AND.KPDS(3).LE.34) THEN - ELSE IF (KPDS(3).EQ.50) THEN - ELSE IF (KPDS(3).EQ.53) THEN - ELSE IF (KPDS(3).GE.70.AND.KPDS(3).LE.77) THEN - ELSE IF (KPDS(3).EQ.98) THEN - ELSE IF (KPDS(3).EQ.99) THEN - ELSE IF (KPDS(3).GE.100.AND.KPDS(3).LE.105) THEN - ELSE IF (KPDS(3).EQ.126) THEN - ELSE IF (KPDS(3).EQ.195) THEN - ELSE IF (KPDS(3).EQ.196) THEN - ELSE IF (KPDS(3).EQ.197) THEN - ELSE IF (KPDS(3).EQ.198) THEN - ELSE IF (KPDS(3).GE.201.AND.KPDS(3).LE.237) THEN - ELSE -C PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR', -C * ' NMC WITHOUT A GRID DESCRIPTION SECTION' -C PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION' -C PRINT *,' PRODUCTION MANAGEMENT BRANCH' -C PRINT *,' W/NMC42)' - END IF - ELSE IF (KPDS(1).EQ.98) THEN - IF (KPDS(3).GE.1.AND.KPDS(3).LE.16) THEN - ELSE -C PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR', -C * ' ECMWF WITHOUT A GRID DESCRIPTION SECTION' -C PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION' -C PRINT *,' PRODUCTION MANAGEMENT BRANCH' -C PRINT *,' W/NMC42)' - END IF - ELSE IF (KPDS(1).EQ.74) THEN - IF (KPDS(3).GE.1.AND.KPDS(3).LE.12) THEN - ELSE IF (KPDS(3).GE.21.AND.KPDS(3).LE.26)THEN - ELSE IF (KPDS(3).GE.61.AND.KPDS(3).LE.64) THEN - ELSE IF (KPDS(3).GE.70.AND.KPDS(3).LE.77) THEN - ELSE -C PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR', -C * ' U.K. MET OFFICE, BRACKNELL', -C * ' WITHOUT A GRID DESCRIPTION SECTION' -C PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION' -C PRINT *,' PRODUCTION MANAGEMENT BRANCH' -C PRINT *,' W/NMC42)' - END IF - ELSE IF (KPDS(1).EQ.58) THEN - IF (KPDS(3).GE.1.AND.KPDS(3).LE.12) THEN - ELSE -C PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR', -C * ' FNOC WITHOUT A GRID DESCRIPTION SECTION' -C PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION' -C PRINT *,' PRODUCTION MANAGEMENT BRANCH' -C PRINT *,' W/NMC42)' - END IF - END IF - END IF - END IF - END IF - RETURN - END - SUBROUTINE FI633(MSGA,KPTR,KGDS,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI633 EXTRACT INFO FROM GRIB-GDS -C PRGMMR: BILL CAVANAUGH ORG: W/NMC42 DATE: 91-09-13 -C -C ABSTRACT: EXTRACT INFORMATION ON UNLISTED GRID TO ALLOW -C CONVERSION TO OFFICE NOTE 84 FORMAT. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 95-03-20 M.BALDWIN FI633 MODIFICATION TO GET -C DATA REP TYPES [KGDS(1)] 201 AND 202 TO WORK. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-09-08 BALDWIN ADD DATA REP TYPE [KGDS(1)] 203 -C 07-04-24 VUONG ADD DATA REP TYPE [KGDS(1)] 204 -C -C -C USAGE: CALL FI633(MSGA,KPTR,KGDS,KRET) -C INPUT ARGUMENT LIST: -C MSGA - ARRAY CONTAINING GRIB MESSAGE -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C KGDS - ARRAY CONTAINING GDS ELEMENTS. -C (1) - DATA REPRESENTATION TYPE -C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS -C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE -C PARAMETERS -C OR -C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS -C IN EACH ROW -C OR -C 255 IF NEITHER ARE PRESENT -C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID -C (22) - NUMBER OF WORDS IN EACH ROW -C LATITUDE/LONGITUDE GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG -C (7) - LA(2) LATITUDE OF EXTREME POINT -C (8) - LO(2) LONGITUDE OF EXTREME POINT -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG -C POLAR STEREOGRAPHIC GRIDS -C (2) - N(I) NR POINTS ALONG LAT CIRCLE -C (3) - N(J) NR POINTS ALONG LON CIRCLE -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESERVED -C (7) - LOV GRID ORIENTATION -C (8) - DX - X DIRECTION INCREMENT -C (9) - DY - Y DIRECTION INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE -C SPHERICAL HARMONIC COEFFICIENTS -C (2) - J PENTAGONAL RESOLUTION PARAMETER -C (3) - K " " " -C (4) - M " " " -C (5) - REPRESENTATION TYPE -C (6) - COEFFICIENT STORAGE MODE -C MERCATOR GRIDS -C (2) - N(I) NR POINTS ON LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG -C (7) - LA(2) LATITUDE OF LAST GRID POINT -C (8) - LO(2) LONGITUDE OF LAST GRID POINT -C (9) - LATIN - LATITUDE OF PROJECTION INTERSECTION -C (10) - RESERVED -C (11) - SCANNING MODE FLAG -C (12) - LONGITUDINAL DIR GRID LENGTH -C (13) - LATITUDINAL DIR GRID LENGTH -C LAMBERT CONFORMAL GRIDS -C (2) - NX NR POINTS ALONG X-AXIS -C (3) - NY NR POINTS ALONG Y-AXIS -C (4) - LA1 LAT OF ORIGIN (LOWER LEFT) -C (5) - LO1 LON OF ORIGIN (LOWER LEFT) -C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17) -C (7) - LOV - ORIENTATION OF GRID -C (8) - DX - X-DIR INCREMENT -C (9) - DY - Y-DIR INCREMENT -C (10) - PROJECTION CENTER FLAG -C (11) - SCANNING MODE FLAG -C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER -C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER -C STAGGERED ARAKAWA ROTATED LAT/LON GRIDS (203) -C (2) - N(I) NR POINTS ON ROTATED LATITUDE CIRCLE -C (3) - N(J) NR POINTS ON ROTATED LONGITUDE MERIDIAN -C (4) - LA(1) LATITUDE OF ORIGIN -C (5) - LO(1) LONGITUDE OF ORIGIN -C (6) - RESOLUTION FLAG -C (7) - LA(2) LATITUDE OF CENTER -C (8) - LO(2) LONGITUDE OF CENTER -C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT -C (10) - DJ LATITUDINAL DIRECTION INCREMENT -C (11) - SCANNING MODE FLAG -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C SEE INPUT LIST -C KRET - ERROR RETURN -C -C REMARKS: -C KRET = 0 -C = 4 - DATA REPRESENTATION TYPE NOT CURRENTLY ACCEPTABLE -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS9000 -C -C$$$ -C ************************************************************ -C INCOMING MESSAGE HOLDER - CHARACTER*1 MSGA(*) -C -C ARRAY GDS ELEMENTS - INTEGER KGDS(*) -C ARRAY OF POINTERS AND COUNTERS - INTEGER KPTR(*) -C - INTEGER KRET -C --------------------------------------------------------------- - KRET = 0 -C PROCESS GRID DEFINITION SECTION (IF PRESENT) -C MAKE SURE BIT POINTER IS PROPERLY SET - KPTR(8) = KPTR(9) + (KPTR(2)*8) + (KPTR(3)*8) + 24 - NSAVE = KPTR(8) - 24 -C BYTE 4 -C NV - NR OF VERT COORD PARAMETERS - CALL GBYTEC (MSGA,KGDS(19),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 5 -C PV - LOCATION - SEE FM92 MANUAL - CALL GBYTEC (MSGA,KGDS(20),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTE 6 -C DATA REPRESENTATION TYPE - CALL GBYTEC (MSGA,KGDS(1),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTES 7-32 ARE GRID DEFINITION DEPENDING ON -C DATA REPRESENTATION TYPE - IF (KGDS(1).EQ.0) THEN - GO TO 1000 - ELSE IF (KGDS(1).EQ.1) THEN - GO TO 4000 - ELSE IF (KGDS(1).EQ.2.OR.KGDS(1).EQ.5) THEN - GO TO 2000 - ELSE IF (KGDS(1).EQ.3) THEN - GO TO 5000 - ELSE IF (KGDS(1).EQ.4) THEN - GO TO 1000 -C ELSE IF (KGDS(1).EQ.10) THEN -C ELSE IF (KGDS(1).EQ.14) THEN -C ELSE IF (KGDS(1).EQ.20) THEN -C ELSE IF (KGDS(1).EQ.24) THEN -C ELSE IF (KGDS(1).EQ.30) THEN -C ELSE IF (KGDS(1).EQ.34) THEN - ELSE IF (KGDS(1).EQ.50) THEN - GO TO 3000 -C ELSE IF (KGDS(1).EQ.60) THEN -C ELSE IF (KGDS(1).EQ.70) THEN -C ELSE IF (KGDS(1).EQ.80) THEN - ELSE IF (KGDS(1).EQ.201.OR.KGDS(1).EQ.202.OR. - & KGDS(1).EQ.203.OR.KGDS(1).EQ.204) THEN - GO TO 1000 - ELSE -C MARK AS GDS/ UNKNOWN DATA REPRESENTATION TYPE - KRET = 4 - RETURN - END IF -C BYTE 33-N VERTICAL COORDINATE PARAMETERS -C ----------- -C BYTES 33-42 EXTENSIONS OF GRID DEFINITION FOR ROTATION -C OR STRETCHING OF THE COORDINATE SYSTEM OR -C LAMBERT CONFORMAL PROJECTION. -C BYTE 43-N VERTICAL COORDINATE PARAMETERS -C ----------- -C BYTES 33-52 EXTENSIONS OF GRID DEFINITION FOR STRETCHED -C AND ROTATED COORDINATE SYSTEM -C BYTE 53-N VERTICAL COORDINATE PARAMETERS -C ----------- -C ************************************************************ -C ------------------- LATITUDE/LONGITUDE GRIDS -C ------------------- ARAKAWA STAGGERED, SEMI-STAGGERED, OR FILLED -C ROTATED LAT/LON GRIDS OR CURVILINEAR ORTHIGINAL GRIDS -C -C ------------------- BYTE 7-8 NR OF POINTS ALONG LATITUDE CIRCLE - 1000 CONTINUE - CALL GBYTEC (MSGA,KGDS(2),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 9-10 NR OF POINTS ALONG LONG MERIDIAN - CALL GBYTEC (MSGA,KGDS(3),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 11-13 LATITUDE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(4),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(4),8388608).NE.0) THEN - KGDS(4) = IAND(KGDS(4),8388607) * (-1) - END IF -C ------------------- BYTE 14-16 LONGITUDE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(5),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(5),8388608).NE.0) THEN - KGDS(5) = - IAND(KGDS(5),8388607) - END IF -C ------------------- BYTE 17 RESOLUTION FLAG - CALL GBYTEC (MSGA,KGDS(6),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 18-20 LATITUDE OF LAST GRID POINT - CALL GBYTEC (MSGA,KGDS(7),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(7),8388608).NE.0) THEN - KGDS(7) = - IAND(KGDS(7),8388607) - END IF -C ------------------- BYTE 21-23 LONGITUDE OF LAST GRID POINT - CALL GBYTEC (MSGA,KGDS(8),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(8),8388608).NE.0) THEN - KGDS(8) = - IAND(KGDS(8),8388607) - END IF -C ------------------- BYTE 24-25 LATITUDINAL DIR INCREMENT - CALL GBYTEC (MSGA,KGDS(9),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 26-27 IF REGULAR LAT/LON GRID -C HAVE LONGIT DIR INCREMENT -C ELSE IF GAUSSIAN GRID -C HAVE NR OF LAT CIRCLES -C BETWEEN POLE AND EQUATOR - CALL GBYTEC (MSGA,KGDS(10),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 28 SCANNING MODE FLAGS - CALL GBYTEC (MSGA,KGDS(11),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 29-32 RESERVED -C SKIP TO START OF BYTE 33 - CALL GBYTEC (MSGA,KGDS(12),KPTR(8),32) - KPTR(8) = KPTR(8) + 32 -C ------------------- - GO TO 900 -C ****************************************************************** -C ' POLAR STEREO PROCESSING ' -C -C ------------------- BYTE 7-8 NR OF POINTS ALONG X=AXIS - 2000 CONTINUE - CALL GBYTEC (MSGA,KGDS(2),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 9-10 NR OF POINTS ALONG Y-AXIS - CALL GBYTEC (MSGA,KGDS(3),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 11-13 LATITUDE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(4),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(4),8388608).NE.0) THEN - KGDS(4) = - IAND(KGDS(4),8388607) - END IF -C ------------------- BYTE 14-16 LONGITUDE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(5),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(5),8388608).NE.0) THEN - KGDS(5) = - IAND(KGDS(5),8388607) - END IF -C ------------------- BYTE 17 RESERVED - CALL GBYTEC (MSGA,KGDS(6),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 18-20 LOV ORIENTATION OF THE GRID - CALL GBYTEC (MSGA,KGDS(7),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(7),8388608).NE.0) THEN - KGDS(7) = - IAND(KGDS(7),8388607) - END IF -C ------------------- BYTE 21-23 DX - THE X DIRECTION INCREMENT - CALL GBYTEC (MSGA,KGDS(8),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(8),8388608).NE.0) THEN - KGDS(8) = - IAND(KGDS(8),8388607) - END IF -C ------------------- BYTE 24-26 DY - THE Y DIRECTION INCREMENT - CALL GBYTEC (MSGA,KGDS(9),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(9),8388608).NE.0) THEN - KGDS(9) = - IAND(KGDS(9),8388607) - END IF -C ------------------- BYTE 27 PROJECTION CENTER FLAG - CALL GBYTEC (MSGA,KGDS(10),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 28 SCANNING MODE - CALL GBYTEC (MSGA,KGDS(11),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 29-32 RESERVED -C SKIP TO START OF BYTE 33 - CALL GBYTEC (MSGA,KGDS(12),KPTR(8),32) - KPTR(8) = KPTR(8) + 32 -C -C ------------------- - GO TO 900 -C -C ****************************************************************** -C ------------------- GRID DESCRIPTION FOR SPHERICAL HARMONIC COEFF. -C -C ------------------- BYTE 7-8 J PENTAGONAL RESOLUTION PARAMETER - 3000 CONTINUE - CALL GBYTEC (MSGA,KGDS(2),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 9-10 K PENTAGONAL RESOLUTION PARAMETER - CALL GBYTEC (MSGA,KGDS(3),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 11-12 M PENTAGONAL RESOLUTION PARAMETER - CALL GBYTEC (MSGA,KGDS(4),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 13 REPRESENTATION TYPE - CALL GBYTEC (MSGA,KGDS(5),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 14 COEFFICIENT STORAGE MODE - CALL GBYTEC (MSGA,KGDS(6),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- EMPTY FIELDS - BYTES 15 - 32 -C SET TO START OF BYTE 33 - KPTR(8) = KPTR(8) + 18 * 8 - GO TO 900 -C ****************************************************************** -C PROCESS MERCATOR GRIDS -C -C ------------------- BYTE 7-8 NR OF POINTS ALONG LATITUDE CIRCLE - 4000 CONTINUE - CALL GBYTEC (MSGA,KGDS(2),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 9-10 NR OF POINTS ALONG LONG MERIDIAN - CALL GBYTEC (MSGA,KGDS(3),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 11-13 LATITUE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(4),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(4),8388608).NE.0) THEN - KGDS(4) = - IAND(KGDS(4),8388607) - END IF -C ------------------- BYTE 14-16 LONGITUDE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(5),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(5),8388608).NE.0) THEN - KGDS(5) = - IAND(KGDS(5),8388607) - END IF -C ------------------- BYTE 17 RESOLUTION FLAG - CALL GBYTEC (MSGA,KGDS(6),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 18-20 LATITUDE OF EXTREME POINT - CALL GBYTEC (MSGA,KGDS(7),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(7),8388608).NE.0) THEN - KGDS(7) = - IAND(KGDS(7),8388607) - END IF -C ------------------- BYTE 21-23 LONGITUDE OF EXTREME POINT - CALL GBYTEC (MSGA,KGDS(8),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(8),8388608).NE.0) THEN - KGDS(8) = - IAND(KGDS(8),8388607) - END IF -C ------------------- BYTE 24-26 LATITUDE OF PROJECTION INTERSECTION - CALL GBYTEC (MSGA,KGDS(9),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(9),8388608).NE.0) THEN - KGDS(9) = - IAND(KGDS(9),8388607) - END IF -C ------------------- BYTE 27 RESERVED - CALL GBYTEC (MSGA,KGDS(10),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 28 SCANNING MODE - CALL GBYTEC (MSGA,KGDS(11),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 29-31 LONGITUDINAL DIR INCREMENT - CALL GBYTEC (MSGA,KGDS(12),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(12),8388608).NE.0) THEN - KGDS(12) = - IAND(KGDS(12),8388607) - END IF -C ------------------- BYTE 32-34 LATITUDINAL DIR INCREMENT - CALL GBYTEC (MSGA,KGDS(13),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(13),8388608).NE.0) THEN - KGDS(13) = - IAND(KGDS(13),8388607) - END IF -C ------------------- BYTE 35-42 RESERVED -C SKIP TO START OF BYTE 43 - KPTR(8) = KPTR(8) + 8 * 8 -C ------------------- - GO TO 900 -C ****************************************************************** -C PROCESS LAMBERT CONFORMAL -C -C ------------------- BYTE 7-8 NR OF POINTS ALONG X-AXIS - 5000 CONTINUE - CALL GBYTEC (MSGA,KGDS(2),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 9-10 NR OF POINTS ALONG Y-AXIS - CALL GBYTEC (MSGA,KGDS(3),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- BYTE 11-13 LATITUDE OF ORIGIN - CALL GBYTEC (MSGA,KGDS(4),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(4),8388608).NE.0) THEN - KGDS(4) = - IAND(KGDS(4),8388607) - END IF -C ------------------- BYTE 14-16 LONGITUDE OF ORIGIN (LOWER LEFT) - CALL GBYTEC (MSGA,KGDS(5),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(5),8388608).NE.0) THEN - KGDS(5) = - IAND(KGDS(5),8388607) - END IF -C ------------------- BYTE 17 RESOLUTION - CALL GBYTEC (MSGA,KGDS(6),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 18-20 LOV -ORIENTATION OF GRID - CALL GBYTEC (MSGA,KGDS(7),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(7),8388608).NE.0) THEN - KGDS(7) = - IAND(KGDS(7),8388607) - END IF -C ------------------- BYTE 21-23 DX - X-DIR INCREMENT - CALL GBYTEC (MSGA,KGDS(8),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 -C ------------------- BYTE 24-26 DY - Y-DIR INCREMENT - CALL GBYTEC (MSGA,KGDS(9),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 -C ------------------- BYTE 27 PROJECTION CENTER FLAG - CALL GBYTEC (MSGA,KGDS(10),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 28 SCANNING MODE - CALL GBYTEC (MSGA,KGDS(11),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ------------------- BYTE 29-31 LATIN1 - 1ST LAT FROM POLE - CALL GBYTEC (MSGA,KGDS(12),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(12),8388608).NE.0) THEN - KGDS(12) = - IAND(KGDS(12),8388607) - END IF -C ------------------- BYTE 32-34 LATIN2 - 2ND LAT FROM POLE - CALL GBYTEC (MSGA,KGDS(13),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(13),8388608).NE.0) THEN - KGDS(13) = - IAND(KGDS(13),8388607) - END IF -C ------------------- BYTE 35-37 LATITUDE OF SOUTHERN POLE - CALL GBYTEC (MSGA,KGDS(14),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(14),8388608).NE.0) THEN - KGDS(14) = - IAND(KGDS(14),8388607) - END IF -C ------------------- BYTE 38-40 LONGITUDE OF SOUTHERN POLE - CALL GBYTEC (MSGA,KGDS(15),KPTR(8),24) - KPTR(8) = KPTR(8) + 24 - IF (IAND(KGDS(15),8388608).NE.0) THEN - KGDS(15) = - IAND(KGDS(15),8388607) - END IF -C ------------------- BYTE 41-42 RESERVED - CALL GBYTEC (MSGA,KGDS(16),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ------------------- - 900 CONTINUE -C -C MORE CODE FOR GRIDS WITH PL -C - IF (KGDS(19).EQ.0.OR.KGDS(19).EQ.255) THEN - IF (KGDS(20).NE.255) THEN - ISUM = 0 - KPTR(8) = NSAVE + (KGDS(20) - 1) * 8 - CALL GBYTESC (MSGA,KGDS(22),KPTR(8),16,0,KGDS(3)) - DO 910 J = 1, KGDS(3) - ISUM = ISUM + KGDS(21+J) - 910 CONTINUE - KGDS(21) = ISUM - END IF - END IF - RETURN - END - SUBROUTINE FI634(MSGA,KPTR,KPDS,KGDS,KBMS,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI634 EXTRACT OR GENERATE BIT MAP FOR OUTPUT -C PRGMMR: BILL CAVANAUGH ORG: W/NMC42 DATE: 91-09-13 -C -C ABSTRACT: IF BIT MAP SEC IS AVAILABLE IN GRIB MESSAGE, EXTRACT -C FOR PROGRAM USE, OTHERWISE GENERATE AN APPROPRIATE BIT MAP. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 91-11-12 CAVANAUGH MODIFIED SIZE OF ECMWF GRIDS 5 - 8. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 97-02-12 W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING -C 97-09-19 IREDELL VECTORIZED BITMAP DECODER -C 98-09-02 GILBERT CORRECTED ERROR IN MAP SIZE FOR U.S. GRID 92 -C 98-09-08 BALDWIN ADD GRIDS 190,192 -C 99-01-20 BALDWIN ADD GRIDS 236,237 -C 01-10-02 ROGERS REDEFINED GRID #218 FOR 12 KM ETA -C REDEFINED GRID 192 FOR NEW 32-KM ETA GRID -C 2003-06-30 GILBERT ADDED GRIDS 145 and 146 for CMAQ -C and GRID 175 for AWIPS over GUAM. -C 2004-09-02 VUONG ADDED AWIPS GRIDS 147, 148, 173 AND 254 -C 2006-12-12 VUONG ADDED AWIPS GRIDS 120 -C 2007-04-20 VUONG ADDED AWIPS GRIDS 176 -C 2007-06-11 VUONG ADDED AWIPS GRIDS 11 TO 18 AND 122 TO 125 -C AND 180 TO 183 -C -C USAGE: CALL FI634(MSGA,KPTR,KPDS,KGDS,KBMS,KRET) -C INPUT ARGUMENT LIST: -C MSGA - BUFR MESSAGE -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C KPDS - ARRAY CONTAINING PDS ELEMENTS. -C (1) - ID OF CENTER -C (2) - MODEL IDENTIFICATION -C (3) - GRID IDENTIFICATION -C (4) - GDS/BMS FLAG -C (5) - INDICATOR OF PARAMETER -C (6) - TYPE OF LEVEL -C (7) - HEIGHT/PRESSURE , ETC OF LEVEL -C (8) - YEAR OF CENTURY -C (9) - MONTH OF YEAR -C (10) - DAY OF MONTH -C (11) - HOUR OF DAY -C (12) - MINUTE OF HOUR -C (13) - INDICATOR OF FORECAST TIME UNIT -C (14) - TIME RANGE 1 -C (15) - TIME RANGE 2 -C (16) - TIME RANGE FLAG -C (17) - NUMBER INCLUDED IN AVERAGE -C -C OUTPUT ARGUMENT LIST: -C KBMS - BITMAP DESCRIBING LOCATION OF OUTPUT ELEMENTS. -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C SEE INPUT LIST -C KRET - ERROR RETURN -C -C REMARKS: -C KRET = 0 - NO ERROR -C = 5 - GRID NOT AVAIL FOR CENTER INDICATED -C =10 - INCORRECT CENTER INDICATOR -C =12 - BYTES 5-6 ARE NOT ZERO IN BMS, PREDEFINED BIT MAP -C NOT PROVIDED BY THIS CENTER -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS9000 -C -C$$$ -C -C INCOMING MESSAGE HOLDER - CHARACTER*1 MSGA(*) -C -C BIT MAP - LOGICAL*1 KBMS(*) -C -C ARRAY OF POINTERS AND COUNTERS - INTEGER KPTR(*) -C ARRAY OF POINTERS AND COUNTERS - INTEGER KPDS(*) - INTEGER KGDS(*) -C - INTEGER KRET - INTEGER MASK(8) -C ----------------------GRID 21 AND GRID 22 ARE THE SAME - LOGICAL*1 GRD21( 1369) -C ----------------------GRID 23 AND GRID 24 ARE THE SAME - LOGICAL*1 GRD23( 1369) - LOGICAL*1 GRD25( 1368) - LOGICAL*1 GRD26( 1368) -C ----------------------GRID 27 AND GRID 28 ARE THE SAME -C ----------------------GRID 29 AND GRID 30 ARE THE SAME -C ----------------------GRID 33 AND GRID 34 ARE THE SAME - LOGICAL*1 GRD50( 1188) -C -----------------------GRID 61 AND GRID 62 ARE THE SAME - LOGICAL*1 GRD61( 4186) -C -----------------------GRID 63 AND GRID 64 ARE THE SAME - LOGICAL*1 GRD63( 4186) -C LOGICAL*1 GRD70(16380)/16380*.TRUE./ -C ------------------------------------------------------------- - DATA GRD21 /1333*.TRUE.,36*.FALSE./ - DATA GRD23 /.TRUE.,36*.FALSE.,1332*.TRUE./ - DATA GRD25 /1297*.TRUE.,71*.FALSE./ - DATA GRD26 /.TRUE.,71*.FALSE.,1296*.TRUE./ - DATA GRD50/ -C LINE 1-4 - & 7*.FALSE.,22*.TRUE.,14*.FALSE.,22*.TRUE., - & 14*.FALSE.,22*.TRUE.,14*.FALSE.,22*.TRUE.,7*.FALSE., -C LINE 5-8 - & 6*.FALSE.,24*.TRUE.,12*.FALSE.,24*.TRUE., - & 12*.FALSE.,24*.TRUE.,12*.FALSE.,24*.TRUE.,6*.FALSE., -C LINE 9-12 - & 5*.FALSE.,26*.TRUE.,10*.FALSE.,26*.TRUE., - & 10*.FALSE.,26*.TRUE.,10*.FALSE.,26*.TRUE.,5*.FALSE., -C LINE 13-16 - & 4*.FALSE.,28*.TRUE., 8*.FALSE.,28*.TRUE., - & 8*.FALSE.,28*.TRUE., 8*.FALSE.,28*.TRUE.,4*.FALSE., -C LINE 17-20 - & 3*.FALSE.,30*.TRUE., 6*.FALSE.,30*.TRUE., - & 6*.FALSE.,30*.TRUE., 6*.FALSE.,30*.TRUE.,3*.FALSE., -C LINE 21-24 - & 2*.FALSE.,32*.TRUE., 4*.FALSE.,32*.TRUE., - & 4*.FALSE.,32*.TRUE., 4*.FALSE.,32*.TRUE.,2*.FALSE., -C LINE 25-28 - & .FALSE.,34*.TRUE., 2*.FALSE.,34*.TRUE., - & 2*.FALSE.,34*.TRUE., 2*.FALSE.,34*.TRUE., .FALSE., -C LINE 29-33 - & 180*.TRUE./ - DATA GRD61 /4096*.TRUE.,90*.FALSE./ - DATA GRD63 /.TRUE.,90*.FALSE.,4095*.TRUE./ - DATA MASK /128,64,32,16,8,4,2,1/ -C -C PRINT *,'FI634' - IF (IAND(KPDS(4),64).EQ.64) THEN -C -C SET UP BIT POINTER -C SECTION 0 SECTION 1 SECTION 2 - KPTR(8) = KPTR(9) + (KPTR(2)*8) + (KPTR(3)*8) + (KPTR(4)*8) + 24 -C -C BYTE 4 NUMBER OF UNUSED BITS AT END OF SECTION 3 -C - CALL GBYTEC (MSGA,KPTR(11),KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C -C BYTE 5,6 TABLE REFERENCE IF 0, BIT MAP FOLLOWS -C - CALL GBYTEC (MSGA,KPTR(12),KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C IF TABLE REFERENCE = 0, EXTRACT BIT MAP - IF (KPTR(12).EQ.0) THEN -C CALCULATE NR OF BITS IN BIT MAP - IBITS = (KPTR(5) - 6) * 8 - KPTR(11) - KPTR(10) = IBITS - IF (KPDS(3).EQ.21.OR.KPDS(3).EQ.22.OR.KPDS(3).EQ.25. - * OR.KPDS(3).EQ.61.OR.KPDS(3).EQ.62) THEN -C NORTHERN HEMISPHERE 21, 22, 25, 61, 62 - CALL FI634X(IBITS,KPTR(8),MSGA,KBMS) - IF (KPDS(3).EQ.25) THEN - KADD = 71 - ELSE IF (KPDS(3).EQ.61.OR.KPDS(3).EQ.62) THEN - KADD = 90 - ELSE - KADD = 36 - END IF - DO 25 I = 1, KADD - KBMS(I+IBITS) = .FALSE. - 25 CONTINUE - KPTR(10) = KPTR(10) + KADD - RETURN - ELSE IF (KPDS(3).EQ.23.OR.KPDS(3).EQ.24.OR.KPDS(3).EQ.26. - * OR.KPDS(3).EQ.63.OR.KPDS(3).EQ.64) THEN -C SOUTHERN HEMISPHERE 23, 24, 26, 63, 64 - CALL FI634X(IBITS,KPTR(8),MSGA,KBMS) - IF (KPDS(3).EQ.26) THEN - KADD = 72 - ELSE IF (KPDS(3).EQ.63.OR.KPDS(3).EQ.64) THEN - KADD = 91 - ELSE - KADD = 37 - END IF - DO 26 I = 1, KADD - KBMS(I+IBITS) = .FALSE. - 26 CONTINUE - KPTR(10) = KPTR(10) + KADD - 1 - RETURN - ELSE IF (KPDS(3).EQ.50) THEN - KPAD = 7 - KIN = 22 - KBITS = 0 - DO 55 I = 1, 7 - DO 54 J = 1, 4 - DO 51 K = 1, KPAD - KBITS = KBITS + 1 - KBMS(KBITS) = .FALSE. - 51 CONTINUE - CALL FI634X(KIN,KPTR(8),MSGA,KBMS(KBITS+1)) - KPTR(8)=KPTR(8)+KIN - KBITS=KBITS+KIN - DO 53 K = 1, KPAD - KBITS = KBITS + 1 - KBMS(KBITS) = .FALSE. - 53 CONTINUE - 54 CONTINUE - KIN = KIN + 2 - KPAD = KPAD - 1 - 55 CONTINUE - DO 57 II = 1, 5 - CALL FI634X(KIN,KPTR(8),MSGA,KBMS(KBITS+1)) - KPTR(8)=KPTR(8)+KIN - KBITS=KBITS+KIN - 57 CONTINUE - ELSE -C EXTRACT BIT MAP FROM BMS FOR OTHER GRIDS - CALL FI634X(IBITS,KPTR(8),MSGA,KBMS) - END IF - RETURN - ELSE -C PRINT *,'FI634-NO PREDEFINED BIT MAP PROVIDED BY THIS CENTER' - KRET = 12 - RETURN - END IF -C - END IF - KRET = 0 -C ------------------------------------------------------- -C PROCESS NON-STANDARD GRID -C ------------------------------------------------------- - IF (KPDS(3).EQ.255) THEN -C PRINT *,'NON STANDARD GRID, CENTER = ',KPDS(1) - J = KGDS(2) * KGDS(3) - KPTR(10) = J - DO 600 I = 1, J - KBMS(I) = .TRUE. - 600 CONTINUE - RETURN - END IF -C ------------------------------------------------------- -C CHECK INTERNATIONAL SET -C ------------------------------------------------------- - IF (KPDS(3).EQ.21.OR.KPDS(3).EQ.22) THEN -C ----- INT'L GRIDS 21, 22 - MAP SIZE 1369 - J = 1369 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 820 - DO 3021 I = 1, 1369 - KBMS(I) = GRD21(I) - 3021 CONTINUE - RETURN - ELSE IF (KPDS(3).EQ.23.OR.KPDS(3).EQ.24) THEN -C ----- INT'L GRIDS 23, 24 - MAP SIZE 1369 - J = 1369 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 820 - DO 3023 I = 1, 1369 - KBMS(I) = GRD23(I) - 3023 CONTINUE - RETURN - ELSE IF (KPDS(3).EQ.25) THEN -C ----- INT'L GRID 25 - MAP SIZE 1368 - J = 1368 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 820 - DO 3025 I = 1, 1368 - KBMS(I) = GRD25(I) - 3025 CONTINUE - RETURN - ELSE IF (KPDS(3).EQ.26) THEN -C ----- INT'L GRID 26 - MAP SIZE 1368 - J = 1368 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 820 - DO 3026 I = 1, 1368 - KBMS(I) = GRD26(I) - 3026 CONTINUE - RETURN - ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44) THEN -C ----- INT'L GRID 37-44 - MAP SIZE 3447 - J = 3447 - GO TO 800 - ELSE IF (KPDS(1).EQ.7.AND.KPDS(3).EQ.50) THEN -C ----- INT'L GRIDS 50 - MAP SIZE 964 - J = 1188 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 890 - DO 3050 I = 1, J - KBMS(I) = GRD50(I) - 3050 CONTINUE - RETURN - ELSE IF (KPDS(3).EQ.61.OR.KPDS(3).EQ.62) THEN -C ----- INT'L GRIDS 61, 62 - MAP SIZE 4186 - J = 4186 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 820 - DO 3061 I = 1, 4186 - KBMS(I) = GRD61(I) - 3061 CONTINUE - RETURN - ELSE IF (KPDS(3).EQ.63.OR.KPDS(3).EQ.64) THEN -C ----- INT'L GRIDS 63, 64 - MAP SIZE 4186 - J = 4186 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 820 - DO 3063 I = 1, 4186 - KBMS(I) = GRD63(I) - 3063 CONTINUE - RETURN - END IF -C ------------------------------------------------------- -C CHECK UNITED STATES SET -C ------------------------------------------------------- - IF (KPDS(1).EQ.7) THEN - IF (KPDS(3).LT.100) THEN - IF (KPDS(3).EQ.1) THEN -C ----- U.S. GRID 1 - MAP SIZE 1679 - J = 1679 - GO TO 800 - END IF - IF (KPDS(3).EQ.2) THEN -C ----- U.S. GRID 2 - MAP SIZE 10512 - J = 10512 - GO TO 800 - ELSE IF (KPDS(3).EQ.3) THEN -C ----- U.S. GRID 3 - MAP SIZE 65160 - J = 65160 - GO TO 800 - ELSE IF (KPDS(3).EQ.4) THEN -C ----- U.S. GRID 4 - MAP SIZE 259920 - J = 259920 - GO TO 800 - ELSE IF (KPDS(3).EQ.5) THEN -C ----- U.S. GRID 5 - MAP SIZE 3021 - J = 3021 - GO TO 800 - ELSE IF (KPDS(3).EQ.6) THEN -C ----- U.S. GRID 6 - MAP SIZE 2385 - J = 2385 - GO TO 800 - ELSE IF (KPDS(3).EQ.8) THEN -C ----- U.S. GRID 8 - MAP SIZE 5104 - J = 5104 - GO TO 800 - ELSE IF (KPDS(3).EQ.10) THEN -C ----- U.S. GRID 10 - MAP SIZE 25020 - J = 25020 - GO TO 800 - ELSE IF (KPDS(3).EQ.11) THEN -C ----- U.S. GRID 11 - MAP SIZE 223920 - J = 223920 - GO TO 800 - ELSE IF (KPDS(3).EQ.12) THEN -C ----- U.S. GRID 12 - MAP SIZE 99631 - J = 99631 - GO TO 800 - ELSE IF (KPDS(3).EQ.13) THEN -C ----- U.S. GRID 13 - MAP SIZE 36391 - J = 36391 - GO TO 800 - ELSE IF (KPDS(3).EQ.14) THEN -C ----- U.S. GRID 14 - MAP SIZE 153811 - J = 153811 - GO TO 800 - ELSE IF (KPDS(3).EQ.15) THEN -C ----- U.S. GRID 15 - MAP SIZE 74987 - J = 74987 - GO TO 800 - ELSE IF (KPDS(3).EQ.16) THEN -C ----- U.S. GRID 16 - MAP SIZE 214268 - J = 214268 - GO TO 800 - ELSE IF (KPDS(3).EQ.17) THEN -C ----- U.S. GRID 17 - MAP SIZE 387136 - J = 387136 - GO TO 800 - ELSE IF (KPDS(3).EQ.18) THEN -C ----- U.S. GRID 18 - MAP SIZE 281866 - J = 281866 - GO TO 800 - ELSE IF (KPDS(3).EQ.27.OR.KPDS(3).EQ.28) THEN -C ----- U.S. GRIDS 27, 28 - MAP SIZE 4225 - J = 4225 - GO TO 800 - ELSE IF (KPDS(3).EQ.29.OR.KPDS(3).EQ.30) THEN -C ----- U.S. GRIDS 29,30 - MAP SIZE 5365 - J = 5365 - GO TO 800 - ELSE IF (KPDS(3).EQ.33.OR.KPDS(3).EQ.34) THEN -C ----- U.S GRID 33, 34 - MAP SIZE 8326 - J = 8326 - GO TO 800 - ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44) THEN -C ----- U.S. GRID 37-44 - MAP SIZE 3447 - J = 3447 - GO TO 800 - ELSE IF (KPDS(3).EQ.45) THEN -C ----- U.S. GRID 45 - MAP SIZE 41760 - J = 41760 - GO TO 800 - ELSE IF (KPDS(3).EQ.53) THEN -C ----- U.S. GRID 53 - MAP SIZE 5967 - J = 5967 - GO TO 800 - ELSE IF (KPDS(3).EQ.55.OR.KPDS(3).EQ.56) THEN -C ----- U.S GRID 55, 56 - MAP SIZE 6177 - J = 6177 - GO TO 800 - ELSE IF (KPDS(3).GE.67.AND.KPDS(3).LE.71) THEN -C ----- U.S GRID 67-71 - MAP SIZE 13689 - J = 13689 - GO TO 800 - ELSE IF (KPDS(3).EQ.72) THEN -C ----- U.S GRID 72 - MAP SIZE 406 - J = 406 - GO TO 800 - ELSE IF (KPDS(3).EQ.73) THEN -C ----- U.S GRID 73 - MAP SIZE 13056 - J = 13056 - GO TO 800 - ELSE IF (KPDS(3).EQ.74) THEN -C ----- U.S GRID 74 - MAP SIZE 10800 - J = 10800 - GO TO 800 - ELSE IF (KPDS(3).GE.75.AND.KPDS(3).LE.77) THEN -C ----- U.S GRID 75-77 - MAP SIZE 12321 - J = 12321 - GO TO 800 - ELSE IF (KPDS(3).EQ.85.OR.KPDS(3).EQ.86) THEN -C ----- U.S GRID 85,86 - MAP SIZE 32400 - J = 32400 - GO TO 800 - ELSE IF (KPDS(3).EQ.87) THEN -C ----- U.S GRID 87 - MAP SIZE 5022 - J = 5022 - GO TO 800 - ELSE IF (KPDS(3).EQ.88) THEN -C ----- U.S GRID 88 - MAP SIZE 317840 - J = 317840 - GO TO 800 - ELSE IF (KPDS(3).EQ.90) THEN -C ----- U.S GRID 90 - MAP SIZE 111723 - J = 111723 - GO TO 800 - ELSE IF (KPDS(3).EQ.91) THEN -C ----- U.S GRID 91 - MAP SIZE 111723 - J = 111723 - GO TO 800 - ELSE IF (KPDS(3).EQ.92) THEN -C ----- U.S GRID 92 - MAP SIZE 111723 - J = 111723 - GO TO 800 - ELSE IF (KPDS(3).EQ.93) THEN -C ----- U.S GRID 93 - MAP SIZE 111723 - J = 111723 - GO TO 800 - ELSE IF (KPDS(3).EQ.94) THEN -C ----- U.S GRID 94 - MAP SIZE 196305 - J = 196305 - GO TO 800 - ELSE IF (KPDS(3).EQ.95) THEN -C ----- U.S GRID 95 - MAP SIZE 36062 - J = 36062 - GO TO 800 - ELSE IF (KPDS(3).EQ.96) THEN -C ----- U.S GRID 96 - MAP SIZE 646602 - J = 646602 - GO TO 800 - ELSE IF (KPDS(3).EQ.97) THEN -C ----- U.S GRID 97 - MAP SIZE 12727 - J = 12727 - GO TO 800 - ELSE IF (KPDS(3).EQ.98) THEN -C ----- U.S GRID 98 - MAP SIZE 18048 - J = 18048 - GO TO 800 - ELSE IF (KPDS(3).EQ.99) THEN -C ----- U.S GRID 99 - MAP SIZE 779385 - J = 779385 - GO TO 800 - END IF - ELSE IF (KPDS(3).GE.100.AND.KPDS(3).LT.200) THEN - IF (KPDS(3).EQ.100) THEN -C ----- U.S. GRID 100 - MAP SIZE 6889 - J = 6889 - GO TO 800 - ELSE IF (KPDS(3).EQ.101) THEN -C ----- U.S. GRID 101 - MAP SIZE 10283 - J = 10283 - GO TO 800 - ELSE IF (KPDS(3).EQ.103) THEN -C ----- U.S. GRID 103 - MAP SIZE 3640 - J = 3640 - GO TO 800 - ELSE IF (KPDS(3).EQ.104) THEN -C ----- U.S. GRID 104 - MAP SIZE 16170 - J = 16170 - GO TO 800 - ELSE IF (KPDS(3).EQ.105) THEN -C ----- U.S. GRID 105 - MAP SIZE 6889 - J = 6889 - GO TO 800 - ELSE IF (KPDS(3).EQ.106) THEN -C ----- U.S. GRID 106 - MAP SIZE 19305 - J = 19305 - GO TO 800 - ELSE IF (KPDS(3).EQ.107) THEN -C ----- U.S. GRID 107 - MAP SIZE 11040 - J = 11040 - GO TO 800 - ELSE IF (KPDS(3).EQ.110) THEN -C ----- U.S. GRID 110 - MAP SIZE 103936 - J = 103936 - GO TO 800 - ELSE IF (KPDS(3).EQ.120) THEN -C ----- U.S. GRID 120 - MAP SIZE 2020800 - J = 2020800 - GO TO 800 - ELSE IF (KPDS(3).EQ.122) THEN -C ----- U.S. GRID 122 - MAP SIZE 162750 - J = 162750 - GO TO 800 - ELSE IF (KPDS(3).EQ.123) THEN -C ----- U.S. GRID 123 - MAP SIZE 100800 - J = 100800 - GO TO 800 - ELSE IF (KPDS(3).EQ.124) THEN -C ----- U.S. GRID 124 - MAP SIZE 75360 - J = 75360 - GO TO 800 - ELSE IF (KPDS(3).EQ.125) THEN -C ----- U.S. GRID 125 - MAP SIZE 102000 - J = 102000 - GO TO 800 - ELSE IF (KPDS(3).EQ.126) THEN -C ----- U.S. GRID 126 - MAP SIZE 72960 - J = 72960 - GO TO 800 - ELSE IF (KPDS(3).EQ.127) THEN -C ----- U.S. GRID 127 - MAP SIZE 294912 - J = 294912 - GO TO 800 - ELSE IF (KPDS(3).EQ.130) THEN -C ----- U.S. GRID 130 - MAP SIZE 151987 - J = 151987 - GO TO 800 - ELSE IF (KPDS(3).EQ.138) THEN -C ----- U.S. GRID 138 - MAP SIZE 134784 - J = 134784 - GO TO 800 - ELSE IF (KPDS(3).EQ.145) THEN -C ----- U.S. GRID 145 - MAP SIZE 24505 - J = 24505 - GO TO 800 - ELSE IF (KPDS(3).EQ.146) THEN -C ----- U.S. GRID 146 - MAP SIZE 23572 - J = 23572 - GO TO 800 - ELSE IF (KPDS(3).EQ.147) THEN -C ----- U.S. GRID 147 - MAP SIZE 69412 - J = 69412 - GO TO 800 - ELSE IF (KPDS(3).EQ.148) THEN -C ----- U.S. GRID 148 - MAP SIZE 117130 - J = 117130 - GO TO 800 - ELSE IF (KPDS(3).EQ.150) THEN -C ----- U.S. GRID 150 - MAP SIZE 806010 - J = 806010 - GO TO 800 - ELSE IF (KPDS(3).EQ.151) THEN -C ----- U.S. GRID 151 - MAP SIZE 205062 - J = 205062 - GO TO 800 - ELSE IF (KPDS(3).EQ.160) THEN -C ----- U.S. GRID 160 - MAP SIZE 28080 - J = 28080 - GO TO 800 - ELSE IF (KPDS(3).EQ.161) THEN -C ----- U.S. GRID 161 - MAP SIZE 13974 - J = 13974 - GO TO 800 - ELSE IF (KPDS(3).EQ.163) THEN -C ----- U.S. GRID 163 - MAP SIZE 727776 - J = 727776 - GO TO 800 - ELSE IF (KPDS(3).EQ.170) THEN -C ----- U.S. GRID 170 - MAP SIZE 131072 - J = 131072 - GO TO 800 - ELSE IF (KPDS(3).EQ.171) THEN -C ----- U.S. GRID 171 - MAP SIZE 716100 - J = 716100 - GO TO 800 - ELSE IF (KPDS(3).EQ.172) THEN -C ----- U.S. GRID 172 - MAP SIZE 489900 - J = 489900 - GO TO 800 - ELSE IF (KPDS(3).EQ.173) THEN -C ----- U.S. GRID 173 - MAP SIZE 9331200 - J = 9331200 - GO TO 800 - ELSE IF (KPDS(3).EQ.174) THEN -C ----- U.S. GRID 174 - MAP SIZE 4147200 - J = 4147200 - GO TO 800 - ELSE IF (KPDS(3).EQ.175) THEN -C ----- U.S. GRID 175 - MAP SIZE 185704 - J = 185704 - GO TO 800 - ELSE IF (KPDS(3).EQ.176) THEN -C ----- U.S. GRID 176 - MAP SIZE 76845 - J = 76845 - GO TO 800 - ELSE IF (KPDS(3).EQ.180) THEN -C ----- U.S. GRID 180 - MAP SIZE 267168 - J = 267168 - GO TO 800 - ELSE IF (KPDS(3).EQ.181) THEN -C ----- U.S. GRID 181 - MAP SIZE 102860 - J = 102860 - GO TO 800 - ELSE IF (KPDS(3).EQ.182) THEN -C ----- U.S. GRID 182 - MAP SIZE 64218 - J = 64218 - GO TO 800 - ELSE IF (KPDS(3).EQ.183) THEN -C ----- U.S. GRID 183 - MAP SIZE 180144 - J = 180144 - GO TO 800 - ELSE IF (KPDS(3).EQ.190) THEN -C ----- U.S GRID 190 - MAP SIZE 12972 - J = 12972 - GO TO 800 - ELSE IF (KPDS(3).EQ.192) THEN -C ----- U.S GRID 192 - MAP SIZE 91719 - J = 91719 - GO TO 800 - ELSE IF (KPDS(3).EQ.194) THEN -C ----- U.S GRID 194 - MAP SIZE 12727 - J = 12727 - GO TO 800 - ELSE IF (KPDS(3).EQ.195) THEN -C ----- U.S. GRID 195 - MAP SIZE 22833 - J = 22833 - GO TO 800 - ELSE IF (KPDS(3).EQ.196) THEN -C ----- U.S. GRID 196 - MAP SIZE 72225 - J = 72225 - GO TO 800 - ELSE IF (KPDS(3).EQ.197) THEN -C ----- U.S. GRID 197 - MAP SIZE 739297 - J = 739297 - GO TO 800 - ELSE IF (KPDS(3).EQ.198) THEN -C ----- U.S. GRID 198 - MAP SIZE 456225 - J = 456225 - GO TO 800 - ELSE IF (IAND(KPDS(4),128).EQ.128) THEN -C ----- U.S. NON-STANDARD GRID - GO TO 895 - END IF - ELSE IF (KPDS(3).GE.200) THEN - IF (KPDS(3).EQ.201) THEN - J = 4225 - GO TO 800 - ELSE IF (KPDS(3).EQ.202) THEN - J = 2795 - GO TO 800 - ELSE IF (KPDS(3).EQ.203.OR.KPDS(3).EQ.205) THEN - J = 1755 - GO TO 800 - ELSE IF (KPDS(3).EQ.204) THEN - J = 6324 - GO TO 800 - ELSE IF (KPDS(3).EQ.206) THEN - J = 2091 - GO TO 800 - ELSE IF (KPDS(3).EQ.207) THEN - J = 1715 - GO TO 800 - ELSE IF (KPDS(3).EQ.208) THEN - J = 783 - GO TO 800 - ELSE IF (KPDS(3).EQ.209) THEN - J = 61325 - GO TO 800 - ELSE IF (KPDS(3).EQ.210) THEN - J = 625 - GO TO 800 - ELSE IF (KPDS(3).EQ.211) THEN - J = 6045 - GO TO 800 - ELSE IF (KPDS(3).EQ.212) THEN - J = 23865 - GO TO 800 - ELSE IF (KPDS(3).EQ.213) THEN - J = 10965 - GO TO 800 - ELSE IF (KPDS(3).EQ.214) THEN - J = 6693 - GO TO 800 - ELSE IF (KPDS(3).EQ.215) THEN - J = 94833 - GO TO 800 - ELSE IF (KPDS(3).EQ.216) THEN - J = 14873 - GO TO 800 - ELSE IF (KPDS(3).EQ.217) THEN - J = 59001 - GO TO 800 - ELSE IF (KPDS(3).EQ.218) THEN - J = 262792 - GO TO 800 - ELSE IF (KPDS(3).EQ.219) THEN - J = 179025 - GO TO 800 - ELSE IF (KPDS(3).EQ.220) THEN - J = 122475 - GO TO 800 - ELSE IF (KPDS(3).EQ.221) THEN - J = 96673 - GO TO 800 - ELSE IF (KPDS(3).EQ.222) THEN - J = 15456 - GO TO 800 - ELSE IF (KPDS(3).EQ.223) THEN - J = 16641 - GO TO 800 - ELSE IF (KPDS(3).EQ.224) THEN - J = 4225 - GO TO 800 - ELSE IF (KPDS(3).EQ.225) THEN - J = 24975 - GO TO 800 - ELSE IF (KPDS(3).EQ.226) THEN - J = 381029 - GO TO 800 - ELSE IF (KPDS(3).EQ.227) THEN - J = 1509825 - GO TO 800 - ELSE IF (KPDS(3).EQ.228) THEN - J = 10512 - GO TO 800 - ELSE IF (KPDS(3).EQ.229) THEN - J = 65160 - GO TO 800 - ELSE IF (KPDS(3).EQ.230) THEN - J = 259920 - GO TO 800 - ELSE IF (KPDS(3).EQ.231) THEN - J = 130320 - GO TO 800 - ELSE IF (KPDS(3).EQ.232) THEN - J = 32760 - GO TO 800 - ELSE IF (KPDS(3).EQ.233) THEN - J = 45216 - GO TO 800 - ELSE IF (KPDS(3).EQ.234) THEN - J = 16093 - GO TO 800 - ELSE IF (KPDS(3).EQ.235) THEN - J = 259200 - GO TO 800 - ELSE IF (KPDS(3).EQ.236) THEN - J = 17063 - GO TO 800 - ELSE IF (KPDS(3).EQ.237) THEN - J = 2538 - GO TO 800 - ELSE IF (KPDS(3).EQ.238) THEN - J = 55825 - GO TO 800 - ELSE IF (KPDS(3).EQ.239) THEN - J = 19065 - GO TO 800 - ELSE IF (KPDS(3).EQ.240) THEN - J = 987601 - GO TO 800 - ELSE IF (KPDS(3).EQ.241) THEN - J = 244305 - GO TO 800 - ELSE IF (KPDS(3).EQ.242) THEN - J = 235025 - GO TO 800 - ELSE IF (KPDS(3).EQ.243) THEN - J = 12726 - GO TO 800 - ELSE IF (KPDS(3).EQ.244) THEN - J = 55825 - GO TO 800 - ELSE IF (KPDS(3).EQ.245) THEN - J = 124992 - GO TO 800 - ELSE IF (KPDS(3).EQ.246) THEN - J = 123172 - GO TO 800 - ELSE IF (KPDS(3).EQ.247) THEN - J = 124992 - GO TO 800 - ELSE IF (KPDS(3).EQ.248) THEN - J = 13635 - GO TO 800 - ELSE IF (KPDS(3).EQ.249) THEN - J = 125881 - GO TO 800 - ELSE IF (KPDS(3).EQ.250) THEN - J = 13635 - GO TO 800 - ELSE IF (KPDS(3).EQ.251) THEN - J = 69720 - GO TO 800 - ELSE IF (KPDS(3).EQ.252) THEN - J = 67725 - GO TO 800 - ELSE IF (KPDS(3).EQ.253) THEN - J = 83552 - GO TO 800 - ELSE IF (KPDS(3).EQ.254) THEN - J = 110700 - GO TO 800 - ELSE IF (IAND(KPDS(4),128).EQ.128) THEN - GO TO 895 - END IF - KRET = 5 - RETURN - END IF - END IF -C ------------------------------------------------------- -C CHECK JAPAN METEOROLOGICAL AGENCY SET -C ------------------------------------------------------- - IF (KPDS(1).EQ.34) THEN - IF (IAND(KPDS(4),128).EQ.128) THEN -C PRINT *,'JMA MAP IS NOT PREDEFINED, THE GDS WILL' -C PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3) - GO TO 900 - END IF - END IF -C ------------------------------------------------------- -C CHECK CANADIAN SET -C ------------------------------------------------------- - IF (KPDS(1).EQ.54) THEN - IF (IAND(KPDS(4),128).EQ.128) THEN -C PRINT *,'CANADIAN MAP IS NOT PREDEFINED, THE GDS WILL' -C PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3) - GO TO 900 - END IF - END IF -C ------------------------------------------------------- -C CHECK FNOC SET -C ------------------------------------------------------- - IF (KPDS(1).EQ.58) THEN - IF (KPDS(3).EQ.220.OR.KPDS(3).EQ.221) THEN -C FNOC GRID 220, 221 - MAPSIZE 3969 (63 * 63) - J = 3969 - KPTR(10) = J - DO I = 1, J - KBMS(I) = .TRUE. - END DO - RETURN - END IF - IF (KPDS(3).EQ.223) THEN -C FNOC GRID 223 - MAPSIZE 10512 (73 * 144) - J = 10512 - KPTR(10) = J - DO I = 1, J - KBMS(I) = .TRUE. - END DO - RETURN - END IF - IF (IAND(KPDS(4),128).EQ.128) THEN -C PRINT *,'FNOC MAP IS NOT PREDEFINED, THE GDS WILL' -C PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3) - GO TO 900 - END IF - END IF -C ------------------------------------------------------- -C CHECK UKMET SET -C ------------------------------------------------------- - IF (KPDS(1).EQ.74) THEN - IF (IAND(KPDS(4),128).EQ.128) THEN - GO TO 820 - END IF - END IF -C ------------------------------------------------------- -C CHECK ECMWF SET -C ------------------------------------------------------- - IF (KPDS(1).EQ.98) THEN - IF (KPDS(3).GE.1.AND.KPDS(3).LE.12) THEN - IF (KPDS(3).GE.5.AND.KPDS(3).LE.8) THEN - J = 1073 - ELSE - J = 1369 - END IF - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 810 - KPTR(10) = J ! Reset For Modified J - DO 1000 I = 1, J - KBMS(I) = .TRUE. - 1000 CONTINUE - RETURN - ELSE IF (KPDS(3).GE.13.AND.KPDS(3).LE.16) THEN - J = 361 - KPTR(10) = J - CALL FI637(J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 810 - DO 1013 I = 1, J - KBMS(I) = .TRUE. - 1013 CONTINUE - RETURN - ELSE IF (IAND(KPDS(4),128).EQ.128) THEN - GO TO 810 - ELSE - KRET = 5 - RETURN - END IF - ELSE -C PRINT *,'CENTER ',KPDS(1),' IS NOT DEFINED' - IF (IAND(KPDS(4),128).EQ.128) THEN -C PRINT *,'GDS WILL BE USED TO UNPACK THE DATA', -C * ' MAP = ',KPDS(3) - GO TO 900 - ELSE - KRET = 10 - RETURN - END IF - END IF -C ======================================= -C - 800 CONTINUE - KPTR(10) = J - CALL FI637 (J,KPDS,KGDS,KRET) - IF(KRET.NE.0) GO TO 801 - DO 2201 I = 1, J - KBMS(I) = .TRUE. - 2201 CONTINUE - RETURN - 801 CONTINUE -C -C ----- THE MAP HAS A GDS, BYTE 7 OF THE (PDS) THE GRID IDENTIFICATION -C ----- IS NOT 255, THE SIZE OF THE GRID IS NOT THE SAME AS THE -C ----- PREDEFINED SIZES OF THE U.S. GRIDS, OR KNOWN GRIDS OF THE -C ----- OF THE OTHER CENTERS. THE GRID CAN BE UNKNOWN, OR FROM AN -C ----- UNKNOWN CENTER, WE WILL USE THE INFORMATION IN THE GDS TO MAKE -C ----- A BIT MAP. -C - 810 CONTINUE -C PRINT *,'ECMWF PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE' - GO TO 895 -C - 820 CONTINUE -C PRINT *,'U.K. MET PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE' - GO TO 895 -C - 890 CONTINUE -C PRINT *,'PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE' - 895 CONTINUE -C PRINT *,'THE GDS TO UNPACK THE DATA, MAP TYPE = ',KPDS(3) -C - 900 CONTINUE - J = KGDS(2) * KGDS(3) -C AFOS AFOS AFOS SPECIAL CASE -C INVOLVES NEXT SINGLE STATEMENT ONLY - IF (KPDS(3).EQ.211) KRET = 0 - KPTR(10) = J - DO 2203 I = 1, J - KBMS(I) = .TRUE. - 2203 CONTINUE -C PRINT *,'EXIT FI634' - RETURN - END -C----------------------------------------------------------------------- - SUBROUTINE FI634X(NPTS,NSKP,MSGA,KBMS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI634X EXTRACT BIT MAP -C PRGMMR: IREDELL ORG: W/NP23 DATE: 91-09-19 -C -C ABSTRACT: EXTRACT THE PACKED BITMAP INTO A LOGICAL ARRAY. -C -C PROGRAM HISTORY LOG: -C 97-09-19 IREDELL VECTORIZED BITMAP DECODER -C -C USAGE: CALL FI634X(NPTS,NSKP,MSGA,KBMS) -C INPUT ARGUMENT LIST: -C NPTS - INTEGER NUMBER OF POINTS IN THE BITMAP FIELD -C NSKP - INTEGER NUMBER OF BITS TO SKIP IN GRIB MESSAGE -C MSGA - CHARACTER*1 GRIB MESSAGE -C -C OUTPUT ARGUMENT LIST: -C KBMS - LOGICAL*1 BITMAP -C -C REMARKS: -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: CRAY -C -C$$$ - CHARACTER*1 MSGA(*) - LOGICAL*1 KBMS(NPTS) - INTEGER ICHK(NPTS) -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CALL GBYTESC(MSGA,ICHK,NSKP,1,0,NPTS) - KBMS=ICHK.NE.0 -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END - SUBROUTINE FI635(MSGA,KPTR,KPDS,KGDS,KBMS,DATA,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI635 EXTRACT GRIB DATA ELEMENTS FROM BDS -C PRGMMR: BILL CAVANAUGH ORG: W/NMC42 DATE: 91-09-13 -C -C ABSTRACT: EXTRACT GRIB DATA FROM BINARY DATA SECTION AND PLACE -C INTO OUTPUT ARRAY IN PROPER POSITION. -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 94-04-01 CAVANAUGH MODIFIED CODE TO INCLUDE DECIMAL SCALING WHEN -C CALCULATING THE VALUE OF DATA POINTS SPECIFIED -C AS BEING EQUAL TO THE REFERENCE VALUE -C 94-11-10 FARLEY INCREASED MXSIZE FROM 72960 TO 260000 -C FOR .5 DEGREE SST ANALYSIS FIELDS -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-08-31 IREDELL ELIMINATED NEED FOR MXSIZE -C -C USAGE: CALL FI635(MSGA,KPTR,KPDS,KGDS,KBMS,DATA,KRET) -C INPUT ARGUMENT LIST: -C MSGA - ARRAY CONTAINING GRIB MESSAGE -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C (1) - TOTAL LENGTH OF GRIB MESSAGE -C (2) - LENGTH OF INDICATOR (SECTION 0) -C (3) - LENGTH OF PDS (SECTION 1) -C (4) - LENGTH OF GDS (SECTION 2) -C (5) - LENGTH OF BMS (SECTION 3) -C (6) - LENGTH OF BDS (SECTION 4) -C (7) - VALUE OF CURRENT BYTE -C (8) - BIT POINTER -C (9) - GRIB START BIT NR -C (10) - GRIB/GRID ELEMENT COUNT -C (11) - NR UNUSED BITS AT END OF SECTION 3 -C (12) - BIT MAP FLAG -C (13) - NR UNUSED BITS AT END OF SECTION 2 -C (14) - BDS FLAGS -C (15) - NR UNUSED BITS AT END OF SECTION 4 -C (16) - RESERVED -C (17) - RESERVED -C (18) - RESERVED -C (19) - BINARY SCALE FACTOR -C (20) - NUM BITS USED TO PACK EACH DATUM -C KPDS - ARRAY CONTAINING PDS ELEMENTS. -C SEE INITIAL ROUTINE -C KBMS - BITMAP DESCRIBING LOCATION OF OUTPUT ELEMENTS. -C -C OUTPUT ARGUMENT LIST: -C KBDS - INFORMATION EXTRACTED FROM BINARY DATA SECTION -C KBDS(1) - N1 -C KBDS(2) - N2 -C KBDS(3) - P1 -C KBDS(4) - P2 -C KBDS(5) - BIT POINTER TO 2ND ORDER WIDTHS -C KBDS(6) - " " " " " BIT MAPS -C KBDS(7) - " " " FIRST ORDER VALUES -C KBDS(8) - " " " SECOND ORDER VALUES -C KBDS(9) - " " START OF BDS -C KBDS(10) - " " MAIN BIT MAP -C KBDS(11) - BINARY SCALING -C KBDS(12) - DECIMAL SCALING -C KBDS(13) - BIT WIDTH OF FIRST ORDER VALUES -C KBDS(14) - BIT MAP FLAG -C 0 = NO SECOND ORDER BIT MAP -C 1 = SECOND ORDER BIT MAP PRESENT -C KBDS(15) - SECOND ORDER BIT WIDTH -C KBDS(16) - CONSTANT / DIFFERENT WIDTHS -C 0 = CONSTANT WIDTHS -C 1 = DIFFERENT WIDTHS -C KBDS(17) - SINGLE DATUM / MATRIX -C 0 = SINGLE DATUM AT EACH GRID POINT -C 1 = MATRIX OF VALUES AT EACH GRID POINT -C (18-20)- UNUSED -C -C DATA - REAL*4 ARRAY OF GRIDDED ELEMENTS IN GRIB MESSAGE. -C KPTR - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS -C SEE INPUT LIST -C KRET - ERROR RETURN -C -C REMARKS: -C ERROR RETURN -C 3 = UNPACKED FIELD IS LARGER THAN 65160 -C 6 = DOES NOT MATCH NR OF ENTRIES FOR THIS GRIB/GRID -C 7 = NUMBER OF BITS IN FILL TOO LARGE -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS9000 -C -C$$$ -C - CHARACTER*1 MSGA(*) -C - LOGICAL*1 KBMS(*) -C - INTEGER KPDS(*) - INTEGER KGDS(*) - INTEGER KBDS(20) - INTEGER KPTR(*) - INTEGER NRBITS - INTEGER,ALLOCATABLE:: KSAVE(:) - INTEGER KSCALE -C - REAL DATA(*) - REAL REFNCE - REAL SCALE - REAL REALKK -C -C -C CHANGED HEX VALUES TO DECIMAL TO MAKE CODE MORE PORTABLE -C -C ************************************************************* -C PRINT *,'ENTER FI635' -C SET UP BIT POINTER - KPTR(8) = KPTR(9) + (KPTR(2)*8) + (KPTR(3)*8) + (KPTR(4)*8) - * + (KPTR(5)*8) + 24 -C ------------- EXTRACT FLAGS -C BYTE 4 - CALL GBYTEC(MSGA,KPTR(14),KPTR(8),4) - KPTR(8) = KPTR(8) + 4 -C --------- NR OF UNUSED BITS IN SECTION 4 - CALL GBYTEC(MSGA,KPTR(15),KPTR(8),4) - KPTR(8) = KPTR(8) + 4 - KEND = KPTR(9) + (KPTR(2)*8) + (KPTR(3)*8) + (KPTR(4)*8) - * + (KPTR(5)*8) + KPTR(6) * 8 - KPTR(15) -C ------------- GET SCALE FACTOR -C BYTES 5,6 -C CHECK SIGN - CALL GBYTEC (MSGA,KSIGN,KPTR(8),1) - KPTR(8) = KPTR(8) + 1 -C GET ABSOLUTE SCALE VALUE - CALL GBYTEC (MSGA,KSCALE,KPTR(8),15) - KPTR(8) = KPTR(8) + 15 - IF (KSIGN.GT.0) THEN - KSCALE = - KSCALE - END IF - SCALE = 2.0**KSCALE - KPTR(19)=KSCALE -C ------------ GET REFERENCE VALUE -C BYTES 7,10 -C CALL GBYTE (MSGA,KREF,KPTR(8),32) - call gbytec(MSGA,JSGN,KPTR(8),1) - call gbytec(MSGA,JEXP,KPTR(8)+1,7) - call gbytec(MSGA,IFR,KPTR(8)+8,24) - KPTR(8) = KPTR(8) + 32 -C -C THE NEXT CODE WILL CONVERT THE IBM370 FLOATING POINT -C TO THE FLOATING POINT USED ON YOUR COMPUTER. -C -C -C PRINT *,109,JSGN,JEXP,IFR -C 109 FORMAT (' JSGN,JEXP,IFR = ',3(1X,Z8)) - IF (IFR.EQ.0) THEN - REFNCE = 0.0 - ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN - REFNCE = 0.0 - ELSE - REFNCE = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) - IF (JSGN.NE.0) REFNCE = - REFNCE - END IF -C PRINT *,'SCALE ',SCALE,' REF VAL ',REFNCE -C ------------- NUMBER OF BITS SPECIFIED FOR EACH ENTRY -C BYTE 11 - CALL GBYTEC (MSGA,KBITS,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 - KBDS(4) = KBITS -C KBDS(13) = KBITS - KPTR(20) = KBITS - IBYT12 = KPTR(8) -C ------------------ IF THERE ARE NO EXTENDED FLAGS PRESENT -C THIS IS WHERE DATA BEGINS AND AND THE PROCESSING -C INCLUDED IN THE FOLLOWING IF...END IF -C WILL BE SKIPPED -C PRINT *,'BASIC FLAGS =',KPTR(14) ,IAND(KPTR(14),1) - IF (IAND(KPTR(14),1).EQ.0) THEN -C PRINT *,'NO EXTENDED FLAGS' - ELSE -C BYTES 12,13 - CALL GBYTEC (MSGA,KOCTET,KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C --------------------------- EXTENDED FLAGS -C BYTE 14 - CALL GBYTEC (MSGA,KXFLAG,KPTR(8),8) -C PRINT *,'HAVE EXTENDED FLAGS',KXFLAG - KPTR(8) = KPTR(8) + 8 - IF (IAND(KXFLAG,16).EQ.0) THEN -C SECOND ORDER VALUES CONSTANT WIDTHS - KBDS(16) = 0 - ELSE -C SECOND ORDER VALUES DIFFERENT WIDTHS - KBDS(16) = 1 - END IF - IF (IAND (KXFLAG,32).EQ.0) THEN -C NO SECONDARY BIT MAP - KBDS(14) = 0 - ELSE -C HAVE SECONDARY BIT MAP - KBDS(14) = 1 - END IF - IF (IAND (KXFLAG,64).EQ.0) THEN -C SINGLE DATUM AT GRID POINT - KBDS(17) = 0 - ELSE -C MATRIX OF VALUES AT GRID POINT - KBDS(17) = 1 - END IF -C ---------------------- NR - FIRST DIMENSION (ROWS) OF EACH MATRIX -C BYTES 15,16 - CALL GBYTEC (MSGA,NR,KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ---------------------- NC - SECOND DIMENSION (COLS) OF EACH MATRIX -C BYTES 17,18 - CALL GBYTEC (MSGA,NC,KPTR(8),16) - KPTR(8) = KPTR(8) + 16 -C ---------------------- NRV - FIRST DIM COORD VALS -C BYTE 19 - CALL GBYTEC (MSGA,NRV,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ---------------------- NC1 - NR COEFF'S OR VALUES -C BYTE 20 - CALL GBYTEC (MSGA,NC1,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ---------------------- NCV - SECOND DIM COORD OR VALUE -C BYTE 21 - CALL GBYTEC (MSGA,NCV,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ---------------------- NC2 - NR COEFF'S OR VALS -C BYTE 22 - CALL GBYTEC (MSGA,NC2,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ---------------------- KPHYS1 - FIRST DIM PHYSICAL SIGNIF -C BYTE 23 - CALL GBYTEC (MSGA,KPHYS1,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C ---------------------- KPHYS2 - SECOND DIM PHYSICAL SIGNIF -C BYTE 24 - CALL GBYTEC (MSGA,KPHYS2,KPTR(8),8) - KPTR(8) = KPTR(8) + 8 -C BYTES 25-N - END IF - IF (KBITS.EQ.0) THEN -C HAVE NO BDS ENTRIES, ALL ENTRIES = REFNCE - SCAL10 = 10.0 ** KPDS(22) - SCAL10 = 1.0 / SCAL10 - REFN10 = REFNCE * SCAL10 - KENTRY = KPTR(10) - DO 210 I = 1, KENTRY - DATA(I) = 0.0 - IF (KBMS(I)) THEN - DATA(I) = REFN10 - END IF - 210 CONTINUE - GO TO 900 - END IF -C PRINT *,'KEND ',KEND,' KPTR(8) ',KPTR(8),'KBITS ',KBITS - KNR = (KEND - KPTR(8)) / KBITS -C PRINT *,'NUMBER OF ENTRIES IN DATA ARRAY',KNR -C -------------------- -C CYCLE THRU BDS UNTIL HAVE USED ALL (SPECIFIED NUMBER) -C ENTRIES. -C ------------- UNUSED BITS IN DATA AREA -C NUMBER OF BYTES IN DATA AREA - NRBYTE = KPTR(6) - 11 -C ------------- TOTAL NR OF USABLE BITS - NRBITS = NRBYTE * 8 - KPTR(15) -C ------------- TOTAL NR OF ENTRIES - KENTRY = NRBITS / KBITS -C ALLOCATE KSAVE - ALLOCATE(KSAVE(KENTRY)) -C -C IF (IAND(KPTR(14),2).EQ.0) THEN -C PRINT *,'SOURCE VALUES IN FLOATING POINT' -C ELSE -C PRINT *,'SOURCE VALUES IN INTEGER' -C END IF -C - IF (IAND(KPTR(14),8).EQ.0) THEN -C PRINT *,'PROCESSING GRID POINT DATA' - IF (IAND(KPTR(14),4).EQ.0) THEN -C PRINT *,' WITH SIMPLE PACKING' - IF (IAND(KPTR(14),1).EQ.0) THEN -C PRINT *,' WITH NO ADDITIONAL FLAGS' - GO TO 4000 - ELSE IF (IAND(KPTR(14),1).NE.0) THEN -C PRINT *,' WITH ADDITIONAL FLAGS',KXFLAG - IF (KBDS(17).EQ.0) THEN -C PRINT *,' SINGLE DATUM EACH GRID PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - ELSE IF (KBDS(17).NE.0) THEN -C PRINT *,' MATRIX OF VALS EACH PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - END IF - END IF - ELSE IF (IAND(KPTR(14),4).NE.0) THEN -C PRINT *,' WITH COMPLEX/SECOND ORDER PACKING' - IF (IAND(KPTR(14),1).EQ.0) THEN -C PRINT *,' WITH NO ADDITIONAL FLAGS' - ELSE IF (IAND(KPTR(14),1).NE.0) THEN -C PRINT *,' WITH ADDITIONAL FLAGS' - IF (KBDS(17).EQ.0) THEN -C PRINT *,' SINGLE DATUM AT EACH PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF -C ROW BY ROW - COL BY COL - CALL FI636 (DATA,MSGA,KBMS, - * REFNCE,KPTR,KPDS,KGDS) - GO TO 900 - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - CALL FI636 (DATA,MSGA,KBMS, - * REFNCE,KPTR,KPDS,KGDS) - GO TO 900 - END IF - ELSE IF (KBDS(17).NE.0) THEN -C PRINT *,' MATRIX OF VALS EACH PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - END IF - END IF - END IF - ELSE IF (IAND(KPTR(14),8).NE.0) THEN -C PRINT *,'PROCESSING SPHERICAL HARMONIC COEFFICIENTS' - IF (IAND(KPTR(14),4).EQ.0) THEN -C PRINT *,' WITH SIMPLE PACKING' - IF (IAND(KPTR(14),1).EQ.0) THEN -C PRINT *,' WITH NO ADDITIONAL FLAGS' - GO TO 5000 - ELSE IF (IAND(KPTR(14),1).NE.0) THEN -C PRINT *,' WITH ADDITIONAL FLAGS' - IF (KBDS(17).EQ.0) THEN -C PRINT *,' SINGLE DATUM EACH GRID PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - ELSE IF (KBDS(17).NE.0) THEN -C PRINT *,' MATRIX OF VALS EACH PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - END IF - END IF - ELSE IF (IAND(KPTR(14),4).NE.0) THEN -C COMPLEX/SECOND ORDER PACKING -C PRINT *,' WITH COMPLEX/SECOND ORDER PACKING' - IF (IAND(KPTR(14),1).EQ.0) THEN -C PRINT *,' WITH NO ADDITIONAL FLAGS' - ELSE IF (IAND(KPTR(14),1).NE.0) THEN -C PRINT *,' WITH ADDITIONAL FLAGS' - IF (KBDS(17).EQ.0) THEN -C PRINT *,' SINGLE DATUM EACH GRID PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - ELSE IF (KBDS(17).NE.0) THEN -C PRINT *,' MATRIX OF VALS EACH PT' - IF (KBDS(14).EQ.0) THEN -C PRINT *,' NO SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - ELSE IF (KBDS(14).NE.0) THEN -C PRINT *,' SEC BIT MAP' - IF (KBDS(16).EQ.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES CONSTANT WIDTH' - ELSE IF (KBDS(16).NE.0) THEN -C PRINT *,' SECOND ORDER', -C * ' VALUES DIFFERENT WIDTHS' - END IF - END IF - END IF - END IF - END IF - END IF - IF(ALLOCATED(KSAVE)) DEALLOCATE(KSAVE) -C PRINT *,' NOT PROCESSED - NOT PROCESSED - NOT PROCESSED' - KRET = 11 - RETURN - 4000 CONTINUE -C **************************************************************** -C -C GRID POINT DATA, SIMPLE PACKING, FLOATING POINT, NO ADDN'L FLAGS -C - SCAL10 = 10.0 ** KPDS(22) - SCAL10 = 1.0 / SCAL10 - IF (KPDS(3).EQ.23.OR.KPDS(3).EQ.24.OR.KPDS(3).EQ.26. - * OR.KPDS(3).EQ.63.OR.KPDS(3).EQ.64) THEN - IF (KPDS(3).EQ.26) THEN - KADD = 72 - ELSE IF (KPDS(3).EQ.63.OR.KPDS(3).EQ.64) THEN - KADD = 91 - ELSE - KADD = 37 - END IF - CALL GBYTESC (MSGA,KSAVE,KPTR(8),KBITS,0,KNR) - KPTR(8) = KPTR(8) + KBITS * KNR - II = 1 - KENTRY = KPTR(10) - DO 4001 I = 1, KENTRY - IF (KBMS(I)) THEN - DATA(I) = (REFNCE+FLOAT(KSAVE(II))*SCALE)*SCAL10 - II = II + 1 - ELSE - DATA(I) = 0.0 - END IF - 4001 CONTINUE - DO 4002 I = 2, KADD - DATA(I) = DATA(1) - 4002 CONTINUE - ELSE IF (KPDS(3).EQ.21.OR.KPDS(3).EQ.22.OR.KPDS(3).EQ.25. - * OR.KPDS(3).EQ.61.OR.KPDS(3).EQ.62) THEN - CALL GBYTESC (MSGA,KSAVE,KPTR(8),KBITS,0,KNR) - II = 1 - KENTRY = KPTR(10) - DO 4011 I = 1, KENTRY - IF (KBMS(I)) THEN - DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10 - II = II + 1 - ELSE - DATA(I) = 0.0 - END IF - 4011 CONTINUE - IF (KPDS(3).EQ.25) THEN - KADD = 71 - ELSE IF (KPDS(3).EQ.61.OR.KPDS(3).EQ.62) THEN - KADD = 90 - ELSE - KADD = 36 - END IF - LASTP = KENTRY - KADD - DO 4012 I = LASTP+1, KENTRY - DATA(I) = DATA(LASTP) - 4012 CONTINUE - ELSE - CALL GBYTESC (MSGA,KSAVE,KPTR(8),KBITS,0,KNR) - II = 1 - KENTRY = KPTR(10) - DO 500 I = 1, KENTRY - IF (KBMS(I)) THEN - DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10 - II = II + 1 - ELSE - DATA(I) = 0.0 - END IF - 500 CONTINUE - END IF - GO TO 900 -C ------------- PROCESS SPHERICAL HARMONIC COEFFICIENTS, -C SIMPLE PACKING, FLOATING POINT, NO ADDN'L FLAGS - 5000 CONTINUE -C PRINT *,'CHECK POINT SPECTRAL COEFF' - KPTR(8) = IBYT12 -C CALL GBYTE (MSGA,KKK,KPTR(8),32) - call gbytec(MSGA,JSGN,KPTR(8),1) - call gbytec(MSGA,JEXP,KPTR(8)+1,7) - call gbytec(MSGA,IFR,KPTR(8)+8,24) - KPTR(8) = KPTR(8) + 32 -C -C THE NEXT CODE WILL CONVERT THE IBM370 FOATING POINT -C TO THE FLOATING POINT USED ON YOUR MACHINE. -C - IF (IFR.EQ.0) THEN - REALKK = 0.0 - ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN - REALKK = 0.0 - ELSE - REALKK = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) - IF (JSGN.NE.0) REALKK = -REALKK - END IF - DATA(1) = REALKK - CALL GBYTESC (MSGA,KSAVE,KPTR(8),KBITS,0,KNR) -C -------------- - DO 6000 I = 1, KENTRY - DATA(I+1) = REFNCE + FLOAT(KSAVE(I)) * SCALE - 6000 CONTINUE - 900 CONTINUE - IF(ALLOCATED(KSAVE)) DEALLOCATE(KSAVE) -C PRINT *,'EXIT FI635' - RETURN - END - SUBROUTINE FI636 (DATA,MSGA,KBMS,REFNCE,KPTR,KPDS,KGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI636 PROCESS SECOND ORDER PACKING -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 92-09-22 -C -C ABSTRACT: PROCESS SECOND ORDER PACKING FROM THE BINARY DATA SECTION -C (BDS) FOR SINGLE DATA ITEMS GRID POINT DATA -C -C PROGRAM HISTORY LOG: -C 93-06-08 CAVANAUGH -C 93-12-15 CAVANAUGH MODIFIED SECOND ORDER POINTERS TO FIRST ORDER -C VALUES AND SECOND ORDER VALUES CORRECTLY. -C 95-04-26 R.E.JONES FI636 CORECTION FOR 2ND ORDER COMPLEX -C UNPACKING. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI636 (DATA,MSGA,KBMS,REFNCE,KPTR,KPDS,KGDS) -C INPUT ARGUMENT LIST: -C -C MSGA - ARRAY CONTAINING GRIB MESSAGE -C REFNCE - REFERENCE VALUE -C KPTR - WORK ARRAY -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C DATA - LOCATION OF OUTPUT ARRAY -C WORKING ARRAY -C KBDS(1) - N1 -C KBDS(2) - N2 -C KBDS(3) - P1 -C KBDS(4) - P2 -C KBDS(5) - BIT POINTER TO 2ND ORDER WIDTHS -C KBDS(6) - " " " " " BIT MAPS -C KBDS(7) - " " " FIRST ORDER VALUES -C KBDS(8) - " " " SECOND ORDER VALUES -C KBDS(9) - " " START OF BDS -C KBDS(10) - " " MAIN BIT MAP -C KBDS(11) - BINARY SCALING -C KBDS(12) - DECIMAL SCALING -C KBDS(13) - BIT WIDTH OF FIRST ORDER VALUES -C KBDS(14) - BIT MAP FLAG -C 0 = NO SECOND ORDER BIT MAP -C 1 = SECOND ORDER BIT MAP PRESENT -C KBDS(15) - SECOND ORDER BIT WIDTH -C KBDS(16) - CONSTANT / DIFFERENT WIDTHS -C 0 = CONSTANT WIDTHS -C 1 = DIFFERENT WIDTHS -C KBDS(17) - SINGLE DATUM / MATRIX -C 0 = SINGLE DATUM AT EACH GRID POINT -C 1 = MATRIX OF VALUES AT EACH GRID POINT -C (18-20)- UNUSED -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS, CRAY -C -C$$$ - REAL DATA(*) - REAL REFN - REAL REFNCE -C - INTEGER KBDS(20) - INTEGER KPTR(*) - character(len=1) BMAP2(1000000) - INTEGER I,IBDS - INTEGER KBIT,IFOVAL,ISOVAL - INTEGER KPDS(*),KGDS(*) -C - LOGICAL*1 KBMS(*) -C - CHARACTER*1 MSGA(*) -C -C ******************* SETUP ****************************** -C PRINT *,'ENTER FI636' -C START OF BMS (BIT POINTER) - DO I = 1,20 - KBDS(I) = 0 - END DO -C BYTE START OF BDS - IBDS = KPTR(2) + KPTR(3) + KPTR(4) + KPTR(5) -C PRINT *,'KPTR(2-5) ',KPTR(2),KPTR(3),KPTR(4),KPTR(5) -C BIT START OF BDS - JPTR = IBDS * 8 -C PRINT *,'JPTR ',JPTR - KBDS(9) = JPTR -C PRINT *,'START OF BDS ',KBDS(9) -C BINARY SCALE VALUE BDS BYTES 5-6 - CALL GBYTEC (MSGA,ISIGN,JPTR+32,1) - CALL GBYTEC (MSGA,KBDS(11),JPTR+33,15) - IF (ISIGN.GT.0) THEN - KBDS(11) = - KBDS(11) - END IF -C PRINT *,'BINARY SCALE VALUE =',KBDS(11) -C EXTRACT REFERENCE VALUE -C CALL GBYTEC(MSGA,JREF,JPTR+48,32) - call gbytec(MSGA,JSGN,KPTR(8),1) - call gbytec(MSGA,JEXP,KPTR(8)+1,7) - call gbytec(MSGA,IFR,KPTR(8)+8,24) - IF (IFR.EQ.0) THEN - REFNCE = 0.0 - ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN - REFNCE = 0.0 - ELSE - REFNCE = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) - IF (JSGN.NE.0) REFNCE = - REFNCE - END IF -C PRINT *,'DECODED REFERENCE VALUE =',REFN,REFNCE -C F O BIT WIDTH - CALL GBYTEC(MSGA,KBDS(13),JPTR+80,8) - JPTR = JPTR + 88 -C AT START OF BDS BYTE 12 -C EXTRACT N1 - CALL GBYTEC (MSGA,KBDS(1),JPTR,16) -C PRINT *,'N1 = ',KBDS(1) - JPTR = JPTR + 16 -C EXTENDED FLAGS - CALL GBYTEC (MSGA,KFLAG,JPTR,8) -C ISOLATE BIT MAP FLAG - IF (IAND(KFLAG,32).NE.0) THEN - KBDS(14) = 1 - ELSE - KBDS(14) = 0 - END IF - IF (IAND(KFLAG,16).NE.0) THEN - KBDS(16) = 1 - ELSE - KBDS(16) = 0 - END IF - IF (IAND(KFLAG,64).NE.0) THEN - KBDS(17) = 1 - ELSE - KBDS(17) = 0 - END IF - JPTR = JPTR + 8 -C EXTRACT N2 - CALL GBYTEC (MSGA,KBDS(2),JPTR,16) -C PRINT *,'N2 = ',KBDS(2) - JPTR = JPTR + 16 -C EXTRACT P1 - CALL GBYTEC (MSGA,KBDS(3),JPTR,16) -C PRINT *,'P1 = ',KBDS(3) - JPTR = JPTR + 16 -C EXTRACT P2 - CALL GBYTEC (MSGA,KBDS(4),JPTR,16) -C PRINT *,'P2 = ',KBDS(4) - JPTR = JPTR + 16 -C SKIP RESERVED BYTE - JPTR = JPTR + 8 -C START OF SECOND ORDER BIT WIDTHS - KBDS(5) = JPTR -C COMPUTE START OF SECONDARY BIT MAP - IF (KBDS(14).NE.0) THEN -C FOR INCLUDED SECONDARY BIT MAP - JPTR = JPTR + (KBDS(3) * 8) - KBDS(6) = JPTR - ELSE -C FOR CONSTRUCTED SECONDARY BIT MAP - KBDS(6) = 0 - END IF -C CREATE POINTER TO START OF FIRST ORDER VALUES - KBDS(7) = KBDS(9) + KBDS(1) * 8 - 8 -C PRINT *,'BIT POINTER TO START OF FOVALS',KBDS(7) -C CREATE POINTER TO START OF SECOND ORDER VALUES - KBDS(8) = KBDS(9) + KBDS(2) * 8 - 8 -C PRINT *,'BIT POINTER TO START OF SOVALS',KBDS(8) -C PRINT *,'KBDS( 1) - N1 ',KBDS( 1) -C PRINT *,'KBDS( 2) - N2 ',KBDS( 2) -C PRINT *,'KBDS( 3) - P1 ',KBDS( 3) -C PRINT *,'KBDS( 4) - P2 ',KBDS( 4) -C PRINT *,'KBDS( 5) - BIT PTR - 2ND ORDER WIDTHS ',KBDS( 5) -C PRINT *,'KBDS( 6) - " " " " BIT MAPS ',KBDS( 6) -C PRINT *,'KBDS( 7) - " " F O VALS ',KBDS( 7) -C PRINT *,'KBDS( 8) - " " S O VALS ',KBDS( 8) -C PRINT *,'KBDS( 9) - " " START OF BDS ',KBDS( 9) -C PRINT *,'KBDS(10) - " " MAIN BIT MAP ',KBDS(10) -C PRINT *,'KBDS(11) - BINARY SCALING ',KBDS(11) -C PRINT *,'KPDS(22) - DECIMAL SCALING ',KPDS(22) -C PRINT *,'KBDS(13) - FO BIT WIDTH ',KBDS(13) -C PRINT *,'KBDS(14) - 2ND ORDER BIT MAP FLAG ',KBDS(14) -C PRINT *,'KBDS(15) - 2ND ORDER BIT WIDTH ',KBDS(15) -C PRINT *,'KBDS(16) - CONSTANT/DIFFERENT WIDTHS ',KBDS(16) -C PRINT *,'KBDS(17) - SINGLE DATUM/MATRIX ',KBDS(17) -C PRINT *,'REFNCE VAL ',REFNCE -C ************************* PROCESS DATA ********************** - IJ = 0 -C ======================================================== - IF (KBDS(14).EQ.0) THEN -C NO BIT MAP, MUST CONSTRUCT ONE - IF (KGDS(2).EQ.65535) THEN - IF (KGDS(20).EQ.255) THEN -C PRINT *,'CANNOT BE USED HERE' - ELSE -C POINT TO PL - LP = KPTR(9) + KPTR(2)*8 + KPTR(3)*8 + KGDS(20)*8 - 8 -C PRINT *,'LP = ',LP - JT = 0 - DO 2000 JZ = 1, KGDS(3) -C GET NUMBER IN CURRENT ROW - CALL GBYTEC (MSGA,NUMBER,LP,16) -C INCREMENT TO NEXT ROW NUMBER - LP = LP + 16 -C PRINT *,'NUMBER IN ROW',JZ,' = ',NUMBER - DO 1500 JQ = 1, NUMBER - IF (JQ.EQ.1) THEN - CALL SBYTEC (BMAP2,1,JT,1) - ELSE - CALL SBYTEC (BMAP2,0,JT,1) - END IF - JT = JT + 1 - 1500 CONTINUE - 2000 CONTINUE - END IF - ELSE - IF (IAND(KGDS(11),32).EQ.0) THEN -C ROW BY ROW -C PRINT *,' ROW BY ROW' - KOUT = KGDS(3) - KIN = KGDS(2) - ELSE -C COL BY COL -C PRINT *,' COL BY COL' - KIN = KGDS(3) - KOUT = KGDS(2) - END IF -C PRINT *,'KIN=',KIN,' KOUT= ',KOUT - DO 200 I = 1, KOUT - DO 150 J = 1, KIN - IF (J.EQ.1) THEN - CALL SBYTEC (BMAP2,1,IJ,1) - ELSE - CALL SBYTEC (BMAP2,0,IJ,1) - END IF - IJ = IJ + 1 - 150 CONTINUE - 200 CONTINUE - END IF - END IF -C ======================================================== -C PRINT 99,(BMAP2(J),J=1,110) -C99 FORMAT ( 10(1X,Z8.8)) -C CALL BINARY (BMAP2,2) -C FOR EACH GRID POINT ENTRY -C - SCALE2 = 2.0**KBDS(11) - SCAL10 = 10.0**KPDS(22) -C PRINT *,'SCALE VALUES - ',SCALE2,SCAL10 - DO 1000 I = 1, KPTR(10) -C GET NEXT MASTER BIT MAP BIT POSITION -C IF NEXT MASTER BIT MAP BIT POSITION IS 'ON' (1) - IF (KBMS(I)) THEN -C WRITE(6,900)I,KBMS(I) -C 900 FORMAT (1X,I4,3X,14HMAIN BIT IS ON,3X,L4) - IF (KBDS(14).NE.0) THEN - CALL GBYTEC (MSGA,KBIT,KBDS(6),1) - ELSE - CALL GBYTEC (BMAP2,KBIT,KBDS(6),1) - END IF -C PRINT *,'KBDS(6) =',KBDS(6),' KBIT =',KBIT - KBDS(6) = KBDS(6) + 1 - IF (KBIT.NE.0) THEN -C PRINT *,' SOB ON' -C GET NEXT FIRST ORDER PACKED VALUE - CALL GBYTEC (MSGA,IFOVAL,KBDS(7),KBDS(13)) - KBDS(7) = KBDS(7) + KBDS(13) -C PRINT *,'FOVAL =',IFOVAL -C GET SECOND ORDER BIT WIDTH - CALL GBYTEC (MSGA,KBDS(15),KBDS(5),8) - KBDS(5) = KBDS(5) + 8 -C PRINT *,KBDS(7)-KBDS(13),' FOVAL =',IFOVAL,' KBDS(5)=', -C * ,KBDS(5), 'ISOWID =',KBDS(15) - ELSE -C PRINT *,' SOB NOT ON' - END IF - ISOVAL = 0 - IF (KBDS(15).EQ.0) THEN -C IF SECOND ORDER BIT WIDTH = 0 -C THEN SECOND ORDER VALUE IS 0 -C SO CALCULATE DATA VALUE FOR THIS POINT -C DATA(I) = (REFNCE + (FLOAT(IFOVAL) * SCALE2)) / SCAL10 - ELSE - CALL GBYTEC (MSGA,ISOVAL,KBDS(8),KBDS(15)) - KBDS(8) = KBDS(8) + KBDS(15) - END IF - DATA(I) = (REFNCE + (FLOAT(IFOVAL + ISOVAL) * - * SCALE2)) / SCAL10 -C PRINT *,I,DATA(I),REFNCE,IFOVAL,ISOVAL,SCALE2,SCAL10 - ELSE -C WRITE(6,901) I,KBMS(I) -C 901 FORMAT (1X,I4,3X,15HMAIN BIT NOT ON,3X,L4) - DATA(I) = 0.0 - END IF -C PRINT *,I,DATA(I),IFOVAL,ISOVAL,KBDS(5),KBDS(15) - 1000 CONTINUE -C ************************************************************** -C PRINT *,'EXIT FI636' - RETURN - END - SUBROUTINE FI637(J,KPDS,KGDS,KRET) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI637 GRIB GRID/SIZE TEST -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 91-09-13 -C -C ABSTRACT: TO TEST WHEN GDS IS AVAILABLE TO SEE IF SIZE MISMATCH -C ON EXISTING GRIDS (BY CENTER) IS INDICATED -C -C PROGRAM HISTORY LOG: -C 91-09-13 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 97-02-12 W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING -C 98-06-17 IREDELL REMOVED ALTERNATE RETURN -C 99-01-20 BALDWIN MODIFY TO HANDLE GRID 237 -C -C USAGE: CALL FI637(J,KPDS,KGDS,KRET) -C INPUT ARGUMENT LIST: -C J - SIZE FOR INDICATED GRID -C KPDS - -C KGDS - -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C J - SIZE FOR INDICATED GRID MODIFIED FOR ECMWF-US 2 -C KRET - ERROR RETURN -C (A MISMATCH WAS DETECTED IF KRET IS NOT ZERO) -C -C REMARKS: -C KRET - -C = 9 - GDS INDICATES SIZE MISMATCH WITH STD GRID -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 77 -C MACHINE: HDS -C -C$$$ - INTEGER KPDS(*) - INTEGER KGDS(*) - INTEGER J - INTEGER I -C --------------------------------------- -C --------------------------------------- -C IF GDS NOT INDICATED, RETURN -C ---------------------------------------- - KRET=0 - IF (IAND(KPDS(4),128).EQ.0) RETURN -C --------------------------------------- -C GDS IS INDICATED, PROCEED WITH TESTING -C --------------------------------------- - IF (KGDS(2).EQ.65535) THEN - RETURN - END IF - KRET=1 - I = KGDS(2) * KGDS(3) -C --------------------------------------- -C INTERNATIONAL SET -C --------------------------------------- - IF (KPDS(3).GE.21.AND.KPDS(3).LE.26) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.50) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.61.AND.KPDS(3).LE.64) THEN - IF (I.NE.J) THEN - RETURN - END IF -C --------------------------------------- -C TEST ECMWF CONTENT -C --------------------------------------- - ELSE IF (KPDS(1).EQ.98) THEN - KRET = 9 - IF (KPDS(3).GE.1.AND.KPDS(3).LE.16) THEN - IF (I.NE.J) THEN - IF (KPDS(3) .NE. 2) THEN - RETURN - ELSEIF (I .NE. 10512) THEN ! Test for US Grid 2 - RETURN - END IF - J = I ! Set to US Grid 2, 2.5 Global - END IF - ELSE - KRET = 5 - RETURN - END IF -C --------------------------------------- -C U.K. MET OFFICE, BRACKNELL -C --------------------------------------- - ELSE IF (KPDS(1).EQ.74) THEN - KRET = 9 - IF (KPDS(3).GE.25.AND.KPDS(3).LE.26) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE - KRET = 5 - RETURN - END IF -C --------------------------------------- -C CANADA -C --------------------------------------- - ELSE IF (KPDS(1).EQ.54) THEN -C PRINT *,' NO CURRENT LISTING OF CANADIAN GRIDS' - RETURN -C --------------------------------------- -C JAPAN METEOROLOGICAL AGENCY -C --------------------------------------- - ELSE IF (KPDS(1).EQ.34) THEN -C PRINT *,' NO CURRENT LISTING OF JMA GRIDS' - RETURN -C --------------------------------------- -C NAVY - FNOC -C --------------------------------------- - ELSE IF (KPDS(1).EQ.58) THEN - IF (KPDS(3).GE.37.AND.KPDS(3).LE.44) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.220.AND.KPDS(3).LE.221) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.223) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE - KRET = 5 - RETURN - END IF -C --------------------------------------- -C U.S. GRIDS -C --------------------------------------- - ELSE IF (KPDS(1).EQ.7) THEN - KRET = 9 - IF (KPDS(3).GE.1.AND.KPDS(3).LE.6) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.8) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.10) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.11.AND.KPDS(3).LE.18) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.27.AND.KPDS(3).LE.30) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.33.AND.KPDS(3).LE.34) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.53) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.55.AND.KPDS(3).LE.56) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.67.AND.KPDS(3).LE.77) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.85.AND.KPDS(3).LE.88) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.90.AND.KPDS(3).LE.99) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.100.OR.KPDS(3).EQ.101) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.103.AND.KPDS(3).LE.107) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.110) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.120) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.122.AND.KPDS(3).LE.127) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.130) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.138) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.145.AND.KPDS(3).LE.148) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.150.OR.KPDS(3).EQ.151) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.160.OR.KPDS(3).EQ.161) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.163) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.170.AND.KPDS(3).LE.176) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.180.AND.KPDS(3).LE.183) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).EQ.190.OR.KPDS(3).EQ.192) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.194.AND.KPDS(3).LE.198) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE IF (KPDS(3).GE.201.AND.KPDS(3).LE.254) THEN - IF (I.NE.J) THEN - RETURN - END IF - ELSE - KRET = 5 - RETURN - END IF - ELSE - KRET = 10 - RETURN - END IF -C ------------------------------------ -C NORMAL EXIT -C ------------------------------------ - KRET = 0 - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi68.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi68.f deleted file mode 100755 index 03a7ec3be2..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi68.f +++ /dev/null @@ -1,184 +0,0 @@ - SUBROUTINE W3FI68 (ID, PDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI68 CONVERT 25 WORD ARRAY TO GRIB PDS -C PRGMMR: R.E.JONES ORG: W/NMC42 DATE: 91-05-14 -C -C ABSTRACT: CONVERTS AN ARRAY OF 25, OR 27 INTEGER WORDS INTO A -C GRIB PRODUCT DEFINITION SECTION (PDS) OF 28 BYTES , OR 30 BYTES. -C IF PDS BYTES > 30, THEY ARE SET TO ZERO. -C -C PROGRAM HISTORY LOG: -C 91-05-08 R.E.JONES -C 92-09-25 R.E.JONES CHANGE TO 25 WORDS OF INPUT, LEVEL -C CAN BE IN TWO WORDS. (10,11) -C 93-01-08 R.E.JONES CHANGE FOR TIME RANGE INDICATOR IF 10, -C STORE TIME P1 IN PDS BYTES 19-20. -C 93-01-26 R.E.JONES CORRECTION FOR FIXED HEIGHT ABOVE -C GROUND LEVEL -C 93-03-29 R.E.JONES ADD SAVE STATEMENT -C 93-06-24 CAVANOUGH MODIFIED PROGRAM TO ALLOW FOR GENERATION -C OF PDS GREATER THAN 28 BYTES (THE DESIRED -C PDS SIZE IS IN ID(1). -C 93-09-30 FARLEY CHANGE TO ALLOW FOR SUBCENTER ID; PUT -C ID(24) INTO PDS(26). -C 93-10-12 R.E.JONES CHANGES FOR ON388 REV. OCT 9,1993, NEW -C LEVELS 125, 200, 201. -C 94-02-23 R.E.JONES TAKE OUT SBYTES, REPLACE WITH DO LOOP -C 94-04-14 R.E.JONES CHANGES FOR ON388 REV. MAR 24,1994, NEW -C LEVELS 115,116. -C 94-12-04 R.E.JONES CHANGE TO ADD ID WORDS 26, 27 FOR PDS -C BYTES 29 AND 30. -C 95-09-07 R.E.JONES CHANGE FOR NEW LEVEL 117, 119. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-06-30 EBISUZAKI LINUX PORT -C 2001-06-05 GILBERT Changed fortran intrinsic function OR() to -C f90 standard intrinsic IOR(). -C 2003-02-25 IREDELL RECOGNIZE LEVEL TYPE 126 -C 2005-05-06 D.C.STOKES RECOGNIZE LEVEL TYPES 235, 237, 238 -C -C USAGE: CALL W3FI68 (ID, PDS) -C INPUT ARGUMENT LIST: -C ID - 25, 27 WORD INTEGER ARRAY -C OUTPUT ARGUMENT LIST: -C PDS - 28 30, OR GREATER CHARACTER PDS FOR EDITION 1 -C -C REMARKS: LAYOUT OF 'ID' ARRAY: -C ID(1) = NUMBER OF BYTES IN PRODUCT DEFINITION SECTION (PDS) -C ID(2) = PARAMETER TABLE VERSION NUMBER -C ID(3) = IDENTIFICATION OF ORIGINATING CENTER -C ID(4) = MODEL IDENTIFICATION (ALLOCATED BY ORIGINATING CENTER) -C ID(5) = GRID IDENTIFICATION -C ID(6) = 0 IF NO GDS SECTION, 1 IF GDS SECTION IS INCLUDED -C ID(7) = 0 IF NO BMS SECTION, 1 IF BMS SECTION IS INCLUDED -C ID(8) = INDICATOR OF PARAMETER AND UNITS (TABLE 2) -C ID(9) = INDICATOR OF TYPE OF LEVEL (TABLE 3) -C ID(10) = VALUE 1 OF LEVEL (0 FOR 1-100,102,103,105,107 -C 109,111,113,115,117,119,125,126,160,200,201, -C 235,237,238 -C LEVEL IS IN ID WORD 11) -C ID(11) = VALUE 2 OF LEVEL -C ID(12) = YEAR OF CENTURY -C ID(13) = MONTH OF YEAR -C ID(14) = DAY OF MONTH -C ID(15) = HOUR OF DAY -C ID(16) = MINUTE OF HOUR (IN MOST CASES SET TO 0) -C ID(17) = FCST TIME UNIT -C ID(18) = P1 PERIOD OF TIME -C ID(19) = P2 PERIOD OF TIME -C ID(20) = TIME RANGE INDICATOR -C ID(21) = NUMBER INCLUDED IN AVERAGE -C ID(22) = NUMBER MISSING FROM AVERAGES -C ID(23) = CENTURY (20, CHANGE TO 21 ON JAN. 1, 2001) -C ID(24) = SUBCENTER IDENTIFICATION -C ID(25) = SCALING POWER OF 10 -C ID(26) = FLAG BYTE, 8 ON/OFF FLAGS -C BIT NUMBER VALUE ID(26) DEFINITION -C 1 0 0 FULL FCST FIELD -C 1 128 FCST ERROR FIELD -C 2 0 0 ORIGINAL FCST FIELD -C 1 64 BIAS CORRECTED FCST FIELD -C 3 0 0 ORIGINAL RESOLUTION RETAINED -C 1 32 SMOOTHED FIELD -C NOTE: ID(26) CAN BE THE SUM OF BITS 1, 2, 3. -C BITS 4-8 NOT USED, SET TO ZERO -C IF ID(1) IS 28, YOU DO NOT NEED ID(26) AND ID(27). -C ID(27) = UNUSED, SET TO 0 SO PDS BYTE 30 IS SET TO ZERO. -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: SiliconGraphics 3.5 FORTRAN 77 -C MACHINE: SiliconGraphics IRIS-4D/25, 35, INDIGO, Indy -C LANGUAGE: CRAY CFT77 FORTRAN -C MACHINE: CRAY C916/256, J916/2048 -C -C$$$ -C - INTEGER ID(*) -C - CHARACTER * 1 PDS(*) -C - PDS(1) = CHAR(MOD(ID(1)/65536,256)) - PDS(2) = CHAR(MOD(ID(1)/256,256)) - PDS(3) = CHAR(MOD(ID(1),256)) - PDS(4) = CHAR(ID(2)) - PDS(5) = CHAR(ID(3)) - PDS(6) = CHAR(ID(4)) - PDS(7) = CHAR(ID(5)) - i = 0 - if (ID(6).ne.0) i = i + 128 - if (ID(7).ne.0) i = i + 64 - PDS(8) = char(i) - - PDS(9) = CHAR(ID(8)) - PDS(10) = CHAR(ID(9)) - I9 = ID(9) -C -C TEST TYPE OF LEVEL TO SEE IF LEVEL IS IN TWO -C WORDS OR ONE -C - IF ((I9.GE.1.AND.I9.LE.100).OR.I9.EQ.102.OR. - & I9.EQ.103.OR.I9.EQ.105.OR.I9.EQ.107.OR. - & I9.EQ.109.OR.I9.EQ.111.OR.I9.EQ.113.OR. - & I9.EQ.115.OR.I9.EQ.117.OR.I9.EQ.119.OR. - & I9.EQ.125.OR.I9.EQ.126.OR.I9.EQ.160.OR. - & I9.EQ.200.OR.I9.EQ.201.OR.I9.EQ.235.OR. - & I9.EQ.237.OR.I9.EQ.238) THEN - LEVEL = ID(11) - IF (LEVEL.LT.0) THEN - LEVEL = - LEVEL - LEVEL = IOR(LEVEL,32768) - END IF - PDS(11) = CHAR(MOD(LEVEL/256,256)) - PDS(12) = CHAR(MOD(LEVEL,256)) - ELSE - PDS(11) = CHAR(ID(10)) - PDS(12) = CHAR(ID(11)) - END IF - PDS(13) = CHAR(ID(12)) - PDS(14) = CHAR(ID(13)) - PDS(15) = CHAR(ID(14)) - PDS(16) = CHAR(ID(15)) - PDS(17) = CHAR(ID(16)) - PDS(18) = CHAR(ID(17)) -C -C TEST TIME RANGE INDICATOR (PDS BYTE 21) FOR 10 -C IF SO PUT TIME P1 IN PDS BYTES 19-20. -C - IF (ID(20).EQ.10) THEN - PDS(19) = CHAR(MOD(ID(18)/256,256)) - PDS(20) = CHAR(MOD(ID(18),256)) - ELSE - PDS(19) = CHAR(ID(18)) - PDS(20) = CHAR(ID(19)) - END IF - PDS(21) = CHAR(ID(20)) - PDS(22) = CHAR(MOD(ID(21)/256,256)) - PDS(23) = CHAR(MOD(ID(21),256)) - PDS(24) = CHAR(ID(22)) - PDS(25) = CHAR(ID(23)) - PDS(26) = CHAR(ID(24)) - ISCALE = ID(25) - IF (ISCALE.LT.0) THEN - ISCALE = -ISCALE - ISCALE = IOR(ISCALE,32768) - END IF - PDS(27) = CHAR(MOD(ISCALE/256,256)) - PDS(28) = CHAR(MOD(ISCALE ,256)) - IF (ID(1).GT.28) THEN - PDS(29) = CHAR(ID(26)) - PDS(30) = CHAR(ID(27)) - END IF -C -C SET PDS 31-?? TO ZERO -C - IF (ID(1).GT.30) THEN - K = ID(1) - DO I = 31,K - PDS(I) = CHAR(0) - END DO - END IF -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi71.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi71.f deleted file mode 100755 index 7f5817b4ca..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi71.f +++ /dev/null @@ -1,1639 +0,0 @@ - SUBROUTINE W3FI71 (IGRID, IGDS, IERR) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI71 MAKE ARRAY USED BY GRIB PACKER FOR GDS -C PRGMMR: R.E.JONES ORG: W/NMC42 DATE: 93-03-26 -C -C ABSTRACT: W3FI71 MAKES A 18, 37, 55, 64, OR 91 WORD INTEGER ARRAY -C USED BY W3FI72 GRIB PACKER TO MAKE THE GRID DESCRIPTION SECTION -C (GDS) - SECTION 2. -C -C PROGRAM HISTORY LOG: -C 92-02-21 R.E.JONES -C 92-07-01 M. FARLEY ADDED REMARKS FOR 'IGDS' ARRAY ELEMENTS. -C ADDED LAMBERT CONFORMAL GRIDS AND ENLARGED -C IDGS ARRAY FROM 14 TO 18 WORDS. -C 92-10-03 R.E.JONES ADDED CORRECTIONS TO AWIPS GRIB TABLES -C 92-10-16 R.E.JONES ADD GAUSSIAN GRID 126 TO TABLES -C 92-10-18 R.E.JONES CORRECTIONS TO LAMBERT CONFORMAL TABLES -C AND OTHER TABLES -C 92-10-19 R.E.JONES ADD GAUSSIAN GRID 98 TO TABLES -C 93-01-25 R.E.JONES ADD ON84 GRIDS 87, 106, 107 TO TABLES -C 93-03-10 R.E.JONES ADD ON84 GRIDS 1, 55, 56 TO TABLES -C 93-03-26 R.E.JONES ADD GRIB GRIDS 2, 3 TO TABLES -C 93-03-29 R.E.JONES ADD SAVE STATEMENT -C 93-06-15 R.E.JONES ADD GRIB GRIDS 37 TO 44 TO TABLES -C 93-09-29 R.E.JONES GAUSSIAN GRID DOCUMENT NOT CORRECT, -C W3FI74 WILL BE CHANGED TO AGREE WITH -C IT. GAUSSIAN GRID 98 TABLE HAS WRONG -C VALUE. -C 93-10-12 R.E.JONES CHANGES FOR ON388 REV. OCT 8,1993 FOR -C GRID 204, 208. -C 93-10-13 R.E.JONES CORRECTION FOR GRIDS 37-44, BYTES 7-8, -C 24-25 SET TO ALL BITS 1 FOR MISSING. -C 93-11-23 R.E.JONES ADD GRIDS 90-93 FOR ETA MODEL -C ADD GRID 4 FOR 720*361 .5 DEG. GRID -C 94-04-12 R.E.JONES CORRECTION FOR GRID 28 -C 94-06-01 R.E.JONES ADD GRID 45, 288*145 1.25 DEG. GRID -C 94-06-22 R.E.JONES ADD GRIDS 94, 95 FOR ETA MODEL -C 95-04-11 R.E.JONES ADD GRIDS 96, 97 FOR ETA MODEL -C 95-05-19 R.E.JONES ADD FROM 20 KM ETA MODEL AWIPS GRID 215 -C 95-10-19 R.E.JONES ADD FROM 20 KM ETA MODEL ALASKA GRID 216 -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 96-05-08 IREDELL CORRECT FIRST LATITUDE FOR GRIDS 27 AND 28 -C 96-07-02 R.E.JONES ADD FROM 10 KM ETA MODEL OLYMPIC GRID 218 -C 96-07-02 R.E.JONES ADD 196 FOR ETA MODEL -C 96-08-15 R.E.JONES ADD O.N. 84 GRID 8 AND 53 AS GRIB GRID 8 -C AND 53 -C 96-11-29 R.E.JONES CORRECTION TO TABLES FOR GRID 21-26, 61-64 -C 97-01-31 IREDELL CORRECT FIRST LATITUDE FOR GRID 30 -C 97-10-20 IREDELL CORRECT LAST LONGITUDE FOR GRID 98 -C 98-07-07 Gilbert Add grids 217 and 219 through 235 -C 98-09-21 BALDWIN ADD GRIDS 190, 192 FOR ETA MODEL -C 99-01-20 BALDWIN ADD GRIDS 236, 237 -C 99-08-18 IREDELL ADD GRID 170 -C 01-03-08 ROGERS CHANGED ETA GRIDS 90-97, ADDED ETA GRIDS -C 194, 198. ADDED AWIPS GRIDS 241,242,243, -C 245, 246, 247, 248, AND 250 -C 01-03-19 VUONG ADDED AWIPS GRIDS 238,239,240, AND 244 -C 01-04-02 VUONG CORRECT LAST LONGITUDE FOR GRID 225 -C 01-05-03 ROGERS ADDED GRID 249 -C 01-10-10 ROGERS REDEFINED 218 FOR 12-KM ETA -C REDEFINED GRID 192 FOR NEW 32-KM ETA GRID -C 02-03-27 VUONG ADDED RSAS GRID 88 AND AWIPS GRIDS 251 AND 252 -C 02-08-06 ROGERS REDEFINED GRIDS 90-93,97,194,245-250 FOR THE -C 8KM HI-RES-WINDOW MODEL AND ADD AWIPS GRID 253 -C 2003-06-30 GILBERT ADDED GRIDS 145 and 146 for CMAQ -C and GRID 175 for AWIPS over GUAM. -C 2003-07-08 VUONG CORRECTED LATITUDE FOR GRID 253 AND 170, ADD GRID -C 110, 127, 171 AND 172 -C 2004-08-05 VUONG CORRECTED LATITUDE FOR GRID 253 -C 2004-09-01 GILBERT Corrected the orientation and projection center flag -C for southern hemisphere grids 28, 172, 220 and 224 -C 2004-09-02 VUONG ADDED GRIDS 147, 148, 173 AND 254 -C 2005-01-04 COOKE Added grids 160, 161 and corrected longitude of orientation for grid 172 -C 2005-03-03 VUONG MOVED GRID 170 TO GRID 174 AND ADD GRID 170 -C 2005-03-21 VUONG ADDED GRIDS 130 -C 2005-09-12 VUONG ADDED GRIDS 163 -C 2006-10-27 VUONG CORRECTED X AND Y-DIRECTION GRID LENGTH FOR GRIDS 252 -C 2006-11-16 VUONG CHANGED THE LONGITUDE FROM NEGATIVE TO POSITIVE DEGREE FOR GRIDS 252 -C 2006-12-12 VUONG CHANGED DATA REPRESENTATION TYPE (OCTET 6) FROM 0 TO 1 FOR GRID 254 -C ADD GRID 120 (CURVILINEAR ORTHOGONAL GRID) -C 2006-12-27 VUONG CORRECTED THE LAT/LON DIRECTION INCREMENT FOR GRID 160 -C 2007-03-21 VUONG CORRECTED THE LAT/LON DIRECTION INCREMENT, RESOULUTION, -C SCANNING MODE FOR GRID 235 AND GRID TYPE 204 FOR GRID 120 -C 2007-04-24 VUONG CORRECTED THE LAT/LON DIRECTION INCREMENT, RESOULUTION, -C FOR GRIDS (219,173,220,171,233,238,239,244,253) AND ADDED -C GRID 176. -C 2007-06-11 VUONG ADDED NEW GRIDS (11,12,13,14,15,16,18,122,123,124,125,138 -C 180, 181, 182, 183) AND CORRECTED THE LAT/LON DIRECTION -C INCREMENT FOR GRID 240. -C 2007-11-06 VUONG CORRECTED THE SCANNING MODE FOR GRIDS (11,12,13,14,15,16,18) -C CHANGED GRID 198 FROM ARAKAWA STAGGERED E-GRID TO POLAR -C STEREOGRAPHIC GRID ADDED NEW GRID 10, 99, 150, 151, 197 -C 2008-01-17 VUONG ADDED NEW GRID 195 AND CHANGED GRID 196 (ARAKAWA-E TO MERCATOR) -C -C USAGE: CALL W3FI71 (IGRID, IGDS, IERR) -C INPUT ARGUMENT LIST: -C IGRID - GRIB GRID NUMBER, OR OFFICE NOTE 84 GRID NUMBER -C -C OUTPUT ARGUMENT LIST: -C IGDS - 18, 37, 55, 64, OR 91 WORD INTEGER ARRAY WITH -C INFORMATION TO MAKE A GRIB GRID DESCRIPTION SECTION. -C IERR - 0 CORRECT EXIT -C 1 GRID TYPE IN IGRID IS NOT IN TABLE -C -C REMARKS: -C 1) OFFICE NOTE GRID TYPE 26 IS 6 IN GRIB, 26 IS AN -C INTERNATIONAL EXCHANGE GRID. -C -C 2) VALUES RETURNED IN 18, 37, 55, 64, OR 91 WORD INTEGER ARRAY -C IGDS VARY DEPENDING ON GRID REPRESENTATION TYPE. -C -C LAT/LON GRID: -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) -C IGDS( 4) = NO. OF POINTS ALONG A LATITUDE -C IGDS( 5) = NO. OF POINTS ALONG A LONGITUDE MERIDIAN -C IGDS( 6) = LATITUDE OF ORIGIN (SOUTH - IVE) -C IGDS( 7) = LONGITUDE OF ORIGIN (WEST -IVE) -C IGDS( 8) = RESOLUTION FLAG (CODE TABLE 7) -C IGDS( 9) = LATITUDE OF EXTREME POINT (SOUTH - IVE) -C IGDS(10) = LONGITUDE OF EXTREME POINT (WEST - IVE) -C IGDS(11) = LATITUDE INCREMENT -C IGDS(12) = LONGITUDE INCREMENT -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID -C IGDS(19) - IGDS(91) FOR GRIDS 37-44, NUMBER OF POINTS -C IN EACH OF 73 ROWS. -C -C GAUSSIAN GRID: -C IGDS( 1) = ... THROUGH ... -C IGDS(10) = ... SAME AS LAT/LON GRID -C IGDS(11) = NUMBER OF LATITUDE LINES BETWEEN A POLE -C AND THE EQUATOR -C IGDS(12) = LONGITUDE INCREMENT -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID -C -C SPHERICAL HARMONICS: -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) -C IGDS( 4) = J - PENTAGONAL RESOLUTION PARAMETER -C IGDS( 5) = K - PENTAGONAL RESOLUTION PARAMETER -C IGDS( 6) = M - PENTAGONAL RESOLUTION PARAMETER -C IGDS( 7) = REPRESENTATION TYPE (CODE TABLE 9) -C IGDS( 8) = REPRESENTATION MODE (CODE TABLE 10) -C IGDS( 9) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID -C -C POLAR STEREOGRAPHIC: -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) -C IGDS( 4) = NO. OF POINTS ALONG X-AXIS -C IGDS( 5) = NO. OF POINTS ALONG Y-AXIS -C IGDS( 6) = LATITUDE OF ORIGIN (SOUTH -IVE) -C IGDS( 7) = LONGITUTE OF ORIGIN (WEST -IVE) -C IGDS( 8) = RESOLUTION FLAG (CODE TABLE 7) -C IGDS( 9) = LONGITUDE OF MERIDIAN PARALLEL TO Y-AXIS -C IGDS(10) = X-DIRECTION GRID LENGTH (INCREMENT) -C IGDS(11) = Y-DIRECTION GRID LENGTH (INCREMENT) -C IGDS(12) = PROJECTION CENTER FLAG (0=NORTH POLE ON PLANE, -C 1=SOUTH POLE ON PLANE, -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = .. NOT USED FOR THIS GRID -C -C MERCATOR: -C IGDS( 1) = ... THROUGH ... -C IGDS(12) = ... SAME AS LAT/LON GRID -C IGDS(13) = LATITUDE AT WHICH PROJECTION CYLINDER -C INTERSECTS EARTH -C IGDS(14) = SCANNING MODE FLAGS -C IGDS(15) = ... THROUGH ... -C IGDS(18) = .. NOT USED FOR THIS GRID -C -C LAMBERT CONFORMAL: -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) -C IGDS( 4) = NO. OF POINTS ALONG X-AXIS -C IGDS( 5) = NO. OF POINTS ALONG Y-AXIS -C IGDS( 6) = LATITUDE OF ORIGIN (SOUTH -IVE) -C IGDS( 7) = LONGITUTE OF ORIGIN (WEST -IVE) -C IGDS( 8) = RESOLUTION FLAG (CODE TABLE 7) -C IGDS( 9) = LONGITUDE OF MERIDIAN PARALLEL TO Y-AXIS -C IGDS(10) = X-DIRECTION GRID LENGTH (INCREMENT) -C IGDS(11) = Y-DIRECTION GRID LENGTH (INCREMENT) -C IGDS(12) = PROJECTION CENTER FLAG (0=NORTH POLE ON PLANE, -C 1=SOUTH POLE ON PLANE, -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = NOT USED -C IGDS(15) = FIRST LATITUDE FROM THE POLE AT WHICH THE -C SECANT CONE CUTS THE SPERICAL EARTH -C IGDS(16) = SECOND LATITUDE ... -C IGDS(17) = LATITUDE OF SOUTH POLE (MILLIDEGREES) -C IGDS(18) = LONGITUDE OF SOUTH POLE (MILLIDEGREES) -C -C ARAKAWA SEMI-STAGGERED E-GRID ON ROTATED LAT/LON GRID -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) [201] -C IGDS( 4) = NI - TOTAL NUMBER OF ACTUAL DATA POINTS -C INCLUDED ON GRID -C IGDS( 5) = NJ - DUMMY SECOND DIMENSION; SET=1 -C IGDS( 6) = LA1 - LATITUDE OF FIRST GRID POINT -C IGDS( 7) = LO1 - LONGITUDE OF FIRST GRID POINT -C IGDS( 8) = RESOLUTION AND COMPONENT FLAG (CODE TABLE 7) -C IGDS( 9) = LA2 - NUMBER OF MASS POINTS ALONG -C SOUTHERNMOST ROW OF GRID -C IGDS(10) = LO2 - NUMBER OF ROWS IN EACH COLUMN -C IGDS(11) = DI - LONGITUDINAL DIRECTION INCREMENT -C IGDS(12) = DJ - LATITUDINAL DIRECTION INCREMENT -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID (SET TO ZERO) -C -C ARAKAWA FILLED E-GRID ON ROTATED LAT/LON GRID -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) [202] -C IGDS( 4) = NI - TOTAL NUMBER OF ACTUAL DATA POINTS -C INCLUDED ON GRID -C IGDS( 5) = NJ - DUMMY SECOND DIMENTION; SET=1 -C IGDS( 6) = LA1 - LATITUDE LATITUDE OF FIRST GRID POINT -C IGDS( 7) = LO1 - LONGITUDE OF FIRST GRID POINT -C IGDS( 8) = RESOLUTION AND COMPONENT FLAG (CODE TABLE 7) -C IGDS( 9) = LA2 - NUMBER OF (ZONAL) POINTS IN EACH ROW -C IGDS(10) = LO2 - NUMBER OF (MERIDIONAL) POINTS IN EACH -C COLUMN -C IGDS(11) = DI - LONGITUDINAL DIRECTION INCREMENT -C IGDS(12) = DJ - LATITUDINAL DIRECTION INCREMENT -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID -C -C ARAKAWA STAGGERED E-GRID ON ROTATED LAT/LON GRID -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) [203] -C IGDS( 4) = NI - NUMBER OF DATA POINTS IN EACH ROW -C IGDS( 5) = NJ - NUMBER OF ROWS -C IGDS( 6) = LA1 - LATITUDE OF FIRST GRID POINT -C IGDS( 7) = LO1 - LONGITUDE OF FIRST GRID POINT -C IGDS( 8) = RESOLUTION AND COMPONENT FLAG (CODE TABLE 7) -C IGDS( 9) = LA2 - CENTRAL LATITUDE -C IGDS(10) = LO2 - CENTRAL LONGTITUDE -C IGDS(11) = DI - LONGITUDINAL DIRECTION INCREMENT -C IGDS(12) = DJ - LATITUDINAL DIRECTION INCREMENT -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID -C -C CURVILINEAR ORTHOGONAL GRID -C IGDS( 1) = NUMBER OF VERTICAL COORDINATES -C IGDS( 2) = PV, PL OR 255 -C IGDS( 3) = DATA REPRESENTATION TYPE (CODE TABLE 6) [204] -C IGDS( 4) = NI - NUMBER OF DATA POINTS IN EACH ROW -C IGDS( 5) = NJ - NUMBER OF ROWS -C IGDS( 6) = RESERVED (SET TO 0) -C IGDS( 7) = RESERVED (SET TO 0) -C IGDS( 8) = RESOLUTION AND COMPONENT FLAG (CODE TABLE 7) -C IGDS( 9) = RESERVED (SET TO 0) -C IGDS(10) = RESERVED (SET TO 0) -C IGDS(11) = RESERVED (SET TO 0) -C IGDS(12) = RESERVED (SET TO 0) -C IGDS(13) = SCANNING MODE FLAGS (CODE TABLE 8) -C IGDS(14) = ... THROUGH ... -C IGDS(18) = ... NOT USED FOR THIS GRID -C -C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C MACHINE: IBM SP -C -C$$$ -C - INTEGER IGRID - INTEGER IGDS (*) - INTEGER GRD1 (18) - INTEGER GRD2 (18) - INTEGER GRD3 (18) - INTEGER GRD4 (18) - INTEGER GRD5 (18) - INTEGER GRD6 (18) - INTEGER GRD8 (18) - INTEGER GRD10 (18) - INTEGER GRD11 (18) - INTEGER GRD12 (18) - INTEGER GRD13 (18) - INTEGER GRD14 (18) - INTEGER GRD15 (18) - INTEGER GRD16 (18) - INTEGER GRD17 (18) - INTEGER GRD18 (18) - INTEGER GRD21 (55) - INTEGER GRD22 (55) - INTEGER GRD23 (55) - INTEGER GRD24 (55) - INTEGER GRD25 (37) - INTEGER GRD26 (37) - INTEGER GRD27 (18) - INTEGER GRD28 (18) - INTEGER GRD29 (18) - INTEGER GRD30 (18) - INTEGER GRD33 (18) - INTEGER GRD34 (18) - INTEGER GRD37 (91) - INTEGER GRD38 (91) - INTEGER GRD39 (91) - INTEGER GRD40 (91) - INTEGER GRD41 (91) - INTEGER GRD42 (91) - INTEGER GRD43 (91) - INTEGER GRD44 (91) - INTEGER GRD45 (18) - INTEGER GRD53 (18) - INTEGER GRD55 (18) - INTEGER GRD56 (18) - INTEGER GRD61 (64) - INTEGER GRD62 (64) - INTEGER GRD63 (64) - INTEGER GRD64 (64) - INTEGER GRD85 (18) - INTEGER GRD86 (18) - INTEGER GRD87 (18) - INTEGER GRD88 (18) - INTEGER GRD90 (18) - INTEGER GRD91 (18) - INTEGER GRD92 (18) - INTEGER GRD93 (18) - INTEGER GRD94 (18) - INTEGER GRD95 (18) - INTEGER GRD96 (18) - INTEGER GRD97 (18) - INTEGER GRD98 (18) - INTEGER GRD99 (18) - INTEGER GRD100(18) - INTEGER GRD101(18) - INTEGER GRD103(18) - INTEGER GRD104(18) - INTEGER GRD105(18) - INTEGER GRD106(18) - INTEGER GRD107(18) - INTEGER GRD110(18) - INTEGER GRD120(18) - INTEGER GRD122(18) - INTEGER GRD123(18) - INTEGER GRD124(18) - INTEGER GRD125(18) - INTEGER GRD126(18) - INTEGER GRD127(18) - INTEGER GRD130(18) - INTEGER GRD138(18) - INTEGER GRD145(18) - INTEGER GRD146(18) - INTEGER GRD147(18) - INTEGER GRD148(18) - INTEGER GRD150(18) - INTEGER GRD151(18) - INTEGER GRD160(18) - INTEGER GRD161(18) - INTEGER GRD163(18) - INTEGER GRD170(18) - INTEGER GRD171(18) - INTEGER GRD172(18) - INTEGER GRD173(18) - INTEGER GRD174(18) - INTEGER GRD175(18) - INTEGER GRD176(18) - INTEGER GRD180(18) - INTEGER GRD181(18) - INTEGER GRD182(18) - INTEGER GRD183(18) - INTEGER GRD190(18) - INTEGER GRD192(18) - INTEGER GRD194(18) - INTEGER GRD195(18) - INTEGER GRD196(18) - INTEGER GRD197(18) - INTEGER GRD198(18) - INTEGER GRD201(18) - INTEGER GRD202(18) - INTEGER GRD203(18) - INTEGER GRD204(18) - INTEGER GRD205(18) - INTEGER GRD206(18) - INTEGER GRD207(18) - INTEGER GRD208(18) - INTEGER GRD209(18) - INTEGER GRD210(18) - INTEGER GRD211(18) - INTEGER GRD212(18) - INTEGER GRD213(18) - INTEGER GRD214(18) - INTEGER GRD215(18) - INTEGER GRD216(18) - INTEGER GRD217(18) - INTEGER GRD218(18) - INTEGER GRD219(18) - INTEGER GRD220(18) - INTEGER GRD221(18) - INTEGER GRD222(18) - INTEGER GRD223(18) - INTEGER GRD224(18) - INTEGER GRD225(18) - INTEGER GRD226(18) - INTEGER GRD227(18) - INTEGER GRD228(18) - INTEGER GRD229(18) - INTEGER GRD230(18) - INTEGER GRD231(18) - INTEGER GRD232(18) - INTEGER GRD233(18) - INTEGER GRD234(18) - INTEGER GRD235(18) - INTEGER GRD236(18) - INTEGER GRD237(18) - INTEGER GRD238(18) - INTEGER GRD239(18) - INTEGER GRD240(18) - INTEGER GRD241(18) - INTEGER GRD242(18) - INTEGER GRD243(18) - INTEGER GRD244(18) - INTEGER GRD245(18) - INTEGER GRD246(18) - INTEGER GRD247(18) - INTEGER GRD248(18) - INTEGER GRD249(18) - INTEGER GRD250(18) - INTEGER GRD251(18) - INTEGER GRD252(18) - INTEGER GRD253(18) - INTEGER GRD254(18) -C - DATA GRD1 / 0, 255, 1, 73, 23, -48090, 0, 128, 48090, - & 0, 513669,513669, 22500, 64, 0, 0, 0, 0/ - DATA GRD2 / 0, 255, 0, 144, 73, 90000, 0, 128, -90000, - & -2500, 2500, 2500, 0, 0, 0, 0, 0, 0/ - DATA GRD3 / 0, 255, 0, 360,181, 90000, 0, 128, -90000, - & -1000, 1000, 1000, 0, 0, 0, 0, 0, 0/ - DATA GRD4 / 0, 255, 0, 720,361, 90000, 0, 128, -90000, - & -500, 500, 500, 0, 0, 0, 0, 0, 0/ - DATA GRD5 / 0, 255, 5, 53, 57, 7647, -133443, 8, -105000, - & 190500, 190500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD6 / 0, 255, 5, 53, 45, 7647, -133443, 8, -105000, - & 190500, 190500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD8 / 0, 255, 1, 116, 44, -48670, 3104, 128, 61050, - & 0, 318830, 318830, 22500, 64, 0, 0, 0, 0/ - DATA GRD10 / 0, 255, 0, 180, 139, 64000, 1000, 128, -74000, - & 359000, 1000, 2000, 0, 0, 0, 0, 0, 0/ - DATA GRD11 / 0, 255, 0, 720, 311, 77500, 0, 128, -77500, - & 359500, 500, 500, 0, 0, 0, 0, 0, 0/ - DATA GRD12 / 0, 255, 0, 301, 331, 55000, 260000, 128, 0, - & 310000, 166, 166, 0, 0, 0, 0, 0, 0/ - DATA GRD13 / 0, 255, 0, 241, 151, 50000, 210000, 128, 25000, - & 250000, 166, 166, 0, 0, 0, 0, 0, 0/ - DATA GRD14 / 0, 255, 0, 511, 301, 30000, 130000, 128, -20000, - & 215000, 166, 166, 0, 0, 0, 0, 0, 0/ - DATA GRD15 / 0, 255, 0, 401, 187, 75000, 140000, 128, 44000, - & 240000, 166, 250, 0, 0, 0, 0, 0, 0/ - DATA GRD16 / 0, 255, 0, 548, 391, 74000, 165000, 128, 48000, - & 237933, 66, 133, 0, 0, 0, 0, 0, 0/ - DATA GRD17 / 0, 255, 0, 736, 526, 50000, 195000, 128, 15000, - & 244000, 66, 66, 0, 0, 0, 0, 0, 0/ - DATA GRD18 / 0, 255, 0, 586, 481, 47000, 261000, 128, 15000, - & 300000, 66, 66, 0, 0, 0, 0, 0, 0/ - DATA GRD21 / 0, 33, 0,65535,37, 0, 0, 128, 90000, - & 180000, 2500, 5000, 64, 0, 0, 0, 0, 0, - & 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 1/ - DATA GRD22 / 0, 33, 0,65535,37, 0, -180000, 128, 90000, - & 0, 2500, 5000, 64, 0, 0, 0, 0, 0, - & 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 1/ - DATA GRD23 / 0, 33, 0,65535, 37, -90000, 0, 128, 0, - & 180000, 2500, 5000, 64, 0, 0, 0, 0, 0, - & 1, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 37/ - DATA GRD24 / 0, 33, 0,65535, 37, -90000, -180000, 128, 0, - & 0, 2500, 5000, 64, 0, 0, 0, 0, 0, - & 1, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, - & 37, 37, 37, 37, 37, 37, 37/ - DATA GRD25 / 0, 33, 0,65535, 19, 0, 0, 128, 90000, - & 355000, 5000, 5000, 64, 0, 0, 0, 0, 0, - & 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, - & 72, 72, 72, 1/ - DATA GRD26 / 0, 33, 0,65535, 19, -90000, 0, 128, 0, - & 355000, 5000, 5000, 64, 0, 0, 0, 0, 0, - & 1, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, 72, - & 72, 72, 72, 72/ - DATA GRD27 / 0, 255, 5, 65, 65, -20826, -125000, 8, -80000, - & 381000, 381000, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD28 / 0, 255, 5, 65, 65, 20826, 145000, 8, -80000, - & 381000, 381000,128, 64, 0, 0, 0, 0, 0/ - DATA GRD29 / 0, 255, 0, 145, 37, 0, 0, 128, 90000, - & 360000, 2500, 2500, 64, 0, 0, 0, 0, 0/ - DATA GRD30 / 0, 255, 0, 145, 37, -90000, 0, 128, 0, - & 360000, 2500, 2500, 64, 0, 0, 0, 0, 0/ - DATA GRD33 / 0, 255, 0, 181, 46, 0, 0, 128, 90000, - & 360000, 2000, 2000, 64, 0, 0, 0, 0, 0/ - DATA GRD34 / 0, 255, 0, 181, 46, -90000, 0, 128, 0, - & 360000, 2000, 2000, 64, 0, 0, 0, 0, 0/ - DATA GRD37 / 0, 33, 0,65535,73, 0, -30000, 128, 90000, - & 60000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 73, 73, 73, 73, 73, 73, 73, 73, 72, 72, 72, 71, 71, 71, 70, - & 70, 69, 69, 68, 67, 67, 66, 65, 65, 64, 63, 62, 61, 60, 60, - & 59, 58, 57, 56, 55, 54, 52, 51, 50, 49, 48, 47, 45, 44, 43, - & 42, 40, 39, 38, 36, 35, 33, 32, 30, 29, 28, 26, 25, 23, 22, - & 20, 19, 17, 16, 14, 12, 11, 9, 8, 6, 5, 3, 2/ - DATA GRD38 / 0, 33, 0,65535,73, 0, 60000, 128, 90000, - & 150000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 73, 73, 73, 73, 73, 73, 73, 73, 72, 72, 72, 71, 71, 71, 70, - & 70, 69, 69, 68, 67, 67, 66, 65, 65, 64, 63, 62, 61, 60, 60, - & 59, 58, 57, 56, 55, 54, 52, 51, 50, 49, 48, 47, 45, 44, 43, - & 42, 40, 39, 38, 36, 35, 33, 32, 30, 29, 28, 26, 25, 23, 22, - & 20, 19, 17, 16, 14, 12, 11, 9, 8, 6, 5, 3, 2/ - DATA GRD39 / 0, 33, 0,65535,73, 0, 150000, 128, 90000, - & -120000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 73, 73, 73, 73, 73, 73, 73, 73, 72, 72, 72, 71, 71, 71, 70, - & 70, 69, 69, 68, 67, 67, 66, 65, 65, 64, 63, 62, 61, 60, 60, - & 59, 58, 57, 56, 55, 54, 52, 51, 50, 49, 48, 47, 45, 44, 43, - & 42, 40, 39, 38, 36, 35, 33, 32, 30, 29, 28, 26, 25, 23, 22, - & 20, 19, 17, 16, 14, 12, 11, 9, 8, 6, 5, 3, 2/ - DATA GRD40 / 0, 33, 0,65535,73, 0, -120000, 128, 90000, - & -30000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 73, 73, 73, 73, 73, 73, 73, 73, 72, 72, 72, 71, 71, 71, 70, - & 70, 69, 69, 68, 67, 67, 66, 65, 65, 64, 63, 62, 61, 60, 60, - & 59, 58, 57, 56, 55, 54, 52, 51, 50, 49, 48, 47, 45, 44, 43, - & 42, 40, 39, 38, 36, 35, 33, 32, 30, 29, 28, 26, 25, 23, 22, - & 20, 19, 17, 16, 14, 12, 11, 9, 8, 6, 5, 3, 2/ - DATA GRD41 / 0, 33, 0,65535,73, -90000, -30000, 128, 0, - & 60000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 2, 3, 5, 6, 8, 9, 11, 12, 14, 16, 17, 19, 20, 22, 23, - & 25, 26, 28, 29, 30, 32, 33, 35, 36, 38, 39, 40, 42, 43, 44, - & 45, 47, 48, 49, 50, 51, 52, 54, 55, 56, 57, 58, 59, 60, 60, - & 61, 62, 63, 64, 65, 65, 66, 67, 67, 68, 69, 69, 70, 70, 71, - & 71, 71, 72, 72, 72, 73, 73, 73, 73, 73, 73, 73, 73/ - DATA GRD42 / 0, 33, 0,65535,73, -90000, 60000, 128, 0, - & 150000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 2, 3, 5, 6, 8, 9, 11, 12, 14, 16, 17, 19, 20, 22, 23, - & 25, 26, 28, 29, 30, 32, 33, 35, 36, 38, 39, 40, 42, 43, 44, - & 45, 47, 48, 49, 50, 51, 52, 54, 55, 56, 57, 58, 59, 60, 60, - & 61, 62, 63, 64, 65, 65, 66, 67, 67, 68, 69, 69, 70, 70, 71, - & 71, 71, 72, 72, 72, 73, 73, 73, 73, 73, 73, 73, 73/ - DATA GRD43 / 0, 33, 0,65535,73, -90000, 150000, 128, 0, - & -120000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 2, 3, 5, 6, 8, 9, 11, 12, 14, 16, 17, 19, 20, 22, 23, - & 25, 26, 28, 29, 30, 32, 33, 35, 36, 38, 39, 40, 42, 43, 44, - & 45, 47, 48, 49, 50, 51, 52, 54, 55, 56, 57, 58, 59, 60, 60, - & 61, 62, 63, 64, 65, 65, 66, 67, 67, 68, 69, 69, 70, 70, 71, - & 71, 71, 72, 72, 72, 73, 73, 73, 73, 73, 73, 73, 73/ - DATA GRD44 / 0, 33, 0,65535,73, -90000, -120000, 128, 0, - & -30000, 1250,65535, 64, 0, 0, 0, 0, 0, - & 2, 3, 5, 6, 8, 9, 11, 12, 14, 16, 17, 19, 20, 22, 23, - & 25, 26, 28, 29, 30, 32, 33, 35, 36, 38, 39, 40, 42, 43, 44, - & 45, 47, 48, 49, 50, 51, 52, 54, 55, 56, 57, 58, 59, 60, 60, - & 61, 62, 63, 64, 65, 65, 66, 67, 67, 68, 69, 69, 70, 70, 71, - & 71, 71, 72, 72, 72, 73, 73, 73, 73, 73, 73, 73, 73/ - DATA GRD45 / 0, 255, 0, 288,145, 90000, 0, 128, -90000, - & -1250, 1250, 1250, 0, 0, 0, 0, 0, 0/ - DATA GRD53 / 0, 255, 1, 117, 51, -61050, 0, 128, 61050, - & 0, 318830, 318830, 22500, 64, 0, 0, 0, 0/ - DATA GRD55 / 0, 255, 5, 87, 71, -10947, -154289, 8, -105000, - & 254000, 254000, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD56 / 0, 255, 5, 87, 71, 7647, -133443, 8, -105000, - & 127000, 127000, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD61 / 0, 33, 0,65535, 46, 0, 0, 128, 90000, - & 180000, 2000, 2000, 64, 0, 0, 0, 0, 0, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 1/ - DATA GRD62 / 0, 33, 0,65535, 46, 0, -180000, 128, 90000, - & 0, 2000, 2000, 64, 0, 0, 0, 0, 0, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 1/ - DATA GRD63 / 0, 33, 0,65535, 46, 0, -90000, 128, 0, - & 180000, 2000, 2000, 64, 0, 0, 0, 0, 0, - & 1, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91/ - DATA GRD64 / 0, 33, 0,65535, 46, -90000, -180000, 128, 0, - & 0, 2000, 2000, 64, 0, 0, 0, 0, 0, - & 1, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - & 91/ - DATA GRD85 / 0, 255, 0, 360, 90, 500, 500, 128, 89500, - & 359500, 1000, 1000, 64, 0, 0, 0, 0, 0/ - DATA GRD86 / 0, 255, 0, 360, 90, -89500, 500, 128, -500, - & 359500, 1000, 1000, 64, 0, 0, 0, 0, 0/ - DATA GRD87 / 0, 255, 5, 81, 62, 22876, -120491, 8, -105000, - & 68153, 68153, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD88 / 0, 255, 5, 580,548, 10000, -128000, 8, -105000, - & 15000, 15000, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD90 / 0, 255,203,223,501, 23060, -92570, 136, 37000, - & -80000, 53,53,64, 0, 0, 0, 0, 0/ - DATA GRD91 / 0, 255,203,223,501, 23060, -110570, 136, 37000, - & -98000, 53,53,64, 0, 0, 0, 0, 0/ - DATA GRD92 / 0, 255,203,223,501, 25986, -127871, 136, 40000, - & -115000, 53,53,64, 0, 0, 0, 0, 0/ - DATA GRD93 / 0, 255,203,223,501, 44232, -169996, 136, 63000, - & -150000, 67,66,64, 0, 0, 0, 0, 0/ - DATA GRD94 / 0, 255,203,345,569, -3441, -148799, 136, 50000, - & -111000, 154,141,64, 0, 0, 0, 0, 0/ - DATA GRD95 / 0, 255,203,146,247, 35222, -131741, 136, 44000, - & -240000, 67, 66,64, 0, 0, 0, 0, 0/ - DATA GRD96 / 0, 255,203,606,1067, -3441, -148799, 136, 50000, - & -111000, 88,75,64, 0, 0, 0, 0, 0/ - DATA GRD97 / 0, 255,203, 89,143, 14451, -71347, 136, 18000, - & -66500, 53, 53,64, 0, 0, 0, 0, 0/ - DATA GRD98 / 0, 255, 4, 192, 94, 88542, 0, 128, -88542, - & -1875, 47,1875, 0, 0, 0, 0, 0, 0/ - DATA GRD99 / 0, 255,203,669,1165, -7450, -144140, 136, 54000, - & -106000, 90, 77, 64, 0, 0, 0, 0, 0/ - DATA GRD100/ 0, 255, 5, 83, 83, 17108, -129296, 8, -105000, - & 91452, 91452, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD101/ 0, 255, 5, 113, 91, 10528, -137146, 8, -105000, - & 91452, 91452, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD103/ 0, 255, 5, 65, 56, 22405, -121352, 8, -105000, - & 91452, 91452, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD104/ 0, 255, 5, 147,110, -268, -139475, 8, -105000, - & 90755, 90755, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD105/ 0, 255, 5, 83, 83, 17529, -129296, 8, -105000, - & 90755, 90755, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD106/ 0, 255, 5, 165,117, 17533, -129296, 8, -105000, - & 45373, 45373, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD107/ 0, 255, 5, 120, 92, 23438, -120168, 8, -105000, - & 45373, 45373, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD110/ 0, 255, 0, 464,224, 25063, -124938, 128, 52938, - & -67063, 125, 125, 64, 0, 0, 0, 0, 0/ - DATA GRD120/ 0, 255,204,1200,1684, 0, 0, 8, 0, - & 0, 0, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD122/ 0, 255,204, 350, 465, 0, 0, 8, 0, - & 0, 0, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD123/ 0, 255,204, 280, 360, 0, 0, 8, 0, - & 0, 0, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD124/ 0, 255,204, 240, 314, 0, 0, 8, 0, - & 0, 0, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD125/ 0, 255,204, 300, 340, 0, 0, 8, 0, - & 0, 0, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD126/ 0, 255, 4, 384,190, 89277, 0, 128, -89277, - & -938, 95, 938, 0, 0, 0, 0, 0, 0/ - DATA GRD127/ 0, 255, 4, 768,384, 89642, 0, 128, -89642, - & -469, 192, 469, 0, 0, 0, 0, 0, 0/ - DATA GRD130/ 0, 255, 3, 451,337, 16281, -126138, 8, -95000, - & 13545, 13545, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD138/ 0, 255, 3, 468,288, 21017, -123282, 8, -97000, - & 12000, 12000, 0, 64, 0, 33000, 45000, 0, 0/ - DATA GRD145/ 0, 255, 3, 169,145, 32174, -90159, 8, -79500, - & 12000, 12000, 0, 64, 0, 36000, 46000, 0, 0/ - DATA GRD146/ 0, 255, 3, 166,142, 32353, -89994, 8, -79500, - & 12000, 12000, 0, 64, 0, 36000, 46000, 0, 0/ - DATA GRD147/ 0, 255, 3, 268,259, 24595, -100998, 8, -97000, - & 12000, 12000, 0, 64, 0, 33000, 45000, 0, 0/ - DATA GRD148/ 0, 255, 3, 442,265, 21821, -120628, 8, -97000, - & 12000, 12000, 0, 64, 0, 33000, 45000, 0, 0/ - DATA GRD150/ 0, 255, 0, 401,201, 5000, -100000, 128, 25000, - & -60000, 100, 100, 64, 0, 0, 0, 0, 0/ - DATA GRD151/ 0, 255, 5, 478, 429, -745, 215860, 8, -110000, - & 33812, 33812, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD160/ 0, 255, 5, 180,156, 19132, -185837, 8, -150000, - & 47625, 47625, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD161/ 0, 255, 0, 137,102, 50750, 271750, 72, -250, - & -19750, 500,500, 0, 0, 0, 0, 0, 0/ - DATA GRD163/ 0, 255, 3,1008,722, 20600, -118300, 8, -95000, - & 5000, 5000, 0, 64, 0, 38000, 38000, 0, 0/ - DATA GRD170/ 0, 255, 4, 512, 256, 89463, 0, 128, -89463, - & -703, 128, 703, 0, 0, 0, 0, 0, 0/ - DATA GRD171/ 0, 255, 5, 770,930, 25032, -119560, 0, -80000, - & 12700, 12700, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD172/ 0, 255, 5, 690,710, -36866, -220194, 0, -260000, - & 12700, 12700, 128, 64, 0, 0, 0, 0, 0/ - DATA GRD173/ 0, 255, 0,4320,2160, 89958, 42, 128, -89958, - & 359958, 83, 83, 0, 0, 0, 0, 0, 0/ - DATA GRD174/ 0, 255, 4,2880,1440, 89938, 62, 72, -89938, - & -62, 125, 125,64, 0, 0, 0, 0, 0/ - DATA GRD175/ 0, 255, 0, 556,334, 0, 130000, 128, 30060, - & 180040, 90, 90, 64, 0, 0, 0, 0, 0/ - DATA GRD176/ 0, 255, 0, 327,235, 49100, -92200, 128, 40910, - & -75900, 35, 50, 0, 0, 0, 0, 0, 0/ - DATA GRD180/ 0, 255, 0, 759,352, 55054, -127000, 128, 17146, - & -45136, 108, 108, 0, 0, 0, 0, 0, 0/ - DATA GRD181/ 0, 255, 0, 370,278, 30054, -100000, 128, 138, - & -60148, 108, 108, 0, 0, 0, 0, 0, 0/ - DATA GRD182/ 0, 255, 0, 278,231, 32973, -170000, 128, 8133, - & -140084, 108, 108, 0, 0, 0, 0, 0, 0/ - DATA GRD183/ 0, 255, 0, 648,278, 75054, -200000, 128, 45138, - & -130124, 108, 108, 0, 0, 0, 0, 0, 0/ - DATA GRD190 / 0, 255,203, 92,141, 182, -149887, 136, 52000, - & -111000, 577,538,64, 0, 0, 0, 0, 0/ - DATA GRD192 / 0, 255,203,237,387, -3441, -148799, 136, 50000, - & -111000, 225,207,64, 0, 0, 0, 0, 0/ - DATA GRD194 / 0, 255,203, 89,143, 16444, -162244, 136, 20250, - & -157350, 53, 53,64, 0, 0, 0, 0, 0/ - DATA GRD195/ 0, 255, 1, 177,129, 16829, -68196, 128, 19747, - & -63972, 2500, 2500, 20000, 64, 0, 0, 0, 0/ - DATA GRD196/ 0, 255, 1, 321,225, 18067, -161626, 128, 23082, - & -153969, 2500, 2500, 20000, 64, 0, 0, 0, 0/ - DATA GRD197/ 0, 255, 3,1073,689, 20192, -121550, 8, -95000, - & 5079, 5079, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD198/ 0, 255, 5, 825, 553, 40530, -178571, 8, -150000, - & 5953, 5953, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD201/ 0, 255, 5, 65, 65, -20826, -150000, 8, -105000, - & 381000, 381000, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD202/ 0, 255, 5, 65, 43, 7838, -141028, 8, -105000, - & 190500, 190500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD203/ 0, 255, 5, 45, 39, 19132, -185837, 8, -150000, - & 190500, 190500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD204/ 0, 255, 1, 93, 68, -25000, 110000, 128, 60644, - & -109129, 160000, 160000, 20000, 64, 0, 0, 0, 0/ - DATA GRD205/ 0, 255, 5, 45, 39, 616, -84904, 8, -60000, - & 190500, 190500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD206/ 0, 255, 3, 51, 41, 22289, -117991, 8, - 95000, - & 81271, 81271, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD207/ 0, 255, 5, 49, 35, 42085, -175641, 8, -150000, - & 95250, 95250, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD208/ 0, 255, 1, 29, 27, 9343, -167315, 128, 28092, - & -145878, 80000, 80000, 20000, 64, 0, 0, 0, 0/ - DATA GRD209/ 0, 255, 3, 275,223, -4850, -151100, 8, -111000, - & 44000, 44000, 0, 64, 0, 45000, 45000, 0, 0/ - DATA GRD210/ 0, 255, 1, 25, 25, 9000, -77000, 128, 26422, - & -58625, 80000, 80000, 20000, 64, 0, 0, 0, 0/ - DATA GRD211/ 0, 255, 3, 93, 65, 12190, -133459, 8, -95000, - & 81271, 81271, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD212/ 0, 255, 3, 185,129, 12190, -133459, 8, -95000, - & 40635, 40635, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD213/ 0, 255, 5, 129, 85, 7838, -141028, 8, -105000, - & 95250, 95250, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD214/ 0, 255, 5, 97, 69, 42085, -175641, 8, -150000, - & 47625, 47625, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD215/ 0, 255, 3, 369,257, 12190, -133459, 8, -95000, - & 20318, 20318, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD216/ 0, 255, 5, 139,107, 30000, -173000, 8, -135000, - & 45000, 45000, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD217/ 0, 255, 5, 277,213, 30000, -173000, 8, -135000, - & 22500, 22500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD218/ 0, 255, 3, 614,428, 12190, -133459, 8, -95000, - & 12191, 12191, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD219/ 0, 255, 5, 385,465, 25032, -119560, 0, -80000, - & 25400, 25400, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD220/ 0, 255, 5, 345,355, -36866, -220194, 0, -260000, - & 25400, 25400, 128, 64, 0, 0, 0, 0, 0/ - DATA GRD221/ 0, 255, 3, 349,277, 1000, -145500, 8, -107000, - & 32463, 32463, 0, 64, 0, 50000, 50000, 0, 0/ - DATA GRD222/ 0, 255, 3, 138,112, -4850, -151100, 8, -111000, - & 88000, 88000, 0, 64, 0, 45000, 45000, 0, 0/ - DATA GRD223/ 0, 255, 5, 129,129, -20826, -150000, 8, -105000, - & 190500, 190500, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD224/ 0, 255, 5, 65, 65, 20826, 120000, 8, -105000, - & 381000, 381000, 128, 64, 0, 0, 0, 0, 0/ - DATA GRD225/ 0, 255, 1, 185,135, -25000, -250000, 128, 60640, - & -109129, 80000, 80000, 20000, 64, 0, 0, 0, 0/ - DATA GRD226/ 0, 255, 3, 737,513, 12190, -133459, 8, -95000, - & 10159, 10159, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD227/ 0, 255, 3,1473,1025, 12190, -133459, 8, -95000, - & 5079, 5079, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD228/ 0, 255, 0, 144, 73, 90000, 0, 128, -90000, - & -2500, 2500, 2500, 64, 0, 0, 0, 0, 0/ - DATA GRD229/ 0, 255, 0, 360,181, 90000, 0, 128, -90000, - & -1000, 1000, 1000, 64, 0, 0, 0, 0, 0/ - DATA GRD230/ 0, 255, 0, 720,361, 90000, 0, 128, -90000, - & -500, 500, 500, 64, 0, 0, 0, 0, 0/ - DATA GRD231/ 0, 255, 0, 720,181, 0, 0, 128, 90000, - & -500, 500, 500, 64, 0, 0, 0, 0, 0/ - DATA GRD232/ 0, 255, 0, 360, 91, 0, 0, 128, 90000, - & -1000, 1000, 1000, 64, 0, 0, 0, 0, 0/ - DATA GRD233/ 0, 255, 0, 288,157, 78000, 0, 128, -78000, - & -1250, 1000, 1250, 0, 0, 0, 0, 0, 0/ - DATA GRD234/ 0, 255, 0, 133,121, 15000, -98000, 128, -45000, - & -65000, 250, 250, 64, 0, 0, 0, 0, 0/ - DATA GRD235/ 0, 255, 0, 720,360, 89750, 250, 128, -89750, - & -250, 500, 500, 0, 0, 0, 0, 0, 0/ - DATA GRD236/ 0, 255, 3, 151,113, 16281, 233862, 8, -95000, - & 40635, 40635, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD237/ 0, 255, 3, 54, 47, 16201, 285720, 8, -107000, - & 32463, 32463, 0, 64, 0, 50000, 50000, 0, 0/ - DATA GRD238/ 0, 255, 0, 275, 203, 50250, 261750, 128, -250, - & -29750, 250, 250, 0, 0, 0, 0, 0, 0/ - DATA GRD239/ 0, 255, 0, 155, 123, 75250, 159500, 128, 44750, - & -123500, 250, 500, 0, 0, 0, 0, 0, 0/ - DATA GRD240/ 0, 255, 5, 1121, 881, 23098, -119036, 8, -105000, - & 4763, 4763, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD241/ 0, 255, 3, 549,445, -4850, -151100, 8, -111000, - & 22000, 22000, 0, 64, 0, 45000, 45000, 0, 0/ - DATA GRD242/ 0, 255, 5, 553,425, 30000, -173000, 8, -135000, - & 11250, 11250, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD243/ 0, 255, 0, 126,101, 10000, -170000, 128, 50000, - & -120000, 400, 400, 64, 0, 0, 0, 0, 0/ - DATA GRD244/ 0, 255, 0, 275, 203, 50250, 261750, 128, -250, - & -29750, 250, 250, 0, 0, 0, 0, 0, 0/ - DATA GRD245/ 0, 255, 3, 336,372, 22980, -92840, 8, -80000, - & 8000, 8000, 0, 64, 0, 35000, 35000, 0, 0/ - DATA GRD246/ 0, 255, 3, 332,371, 25970, -127973, 8, -115000, - & 8000, 8000, 0, 64, 0, 40000, 40000, 0, 0/ - DATA GRD247/ 0, 255, 3, 336,372, 22980, -110840, 8, -98000, - & 8000, 8000, 0, 64, 0, 35000, 35000, 0, 0/ - DATA GRD248/ 0, 255, 0, 135,101, 14500, -71500, 128, 22000, - & -61450, 75, 75, 64, 0, 0, 0, 0, 0/ - DATA GRD249/ 0, 255, 5, 367,343, 45400, -171600, 8, -150000, - & 9868, 9868, 0, 64, 0, 0, 0, 0, 0/ - DATA GRD250/ 0, 255, 0, 135,101, 16500, -162000, 128, 24000, - & -151950, 75, 75, 64, 0, 0, 0, 0, 0/ - DATA GRD251/ 0, 255, 0, 332,210, 26350, -83050, 128, 47250, - & -49950, 100, 100, 64, 0, 0, 0, 0, 0/ - DATA GRD252/ 0, 255, 3, 301,225, 16281, 233862, 8, 265000, - & 20318, 20318, 0, 64, 0, 25000, 25000, 0, 0/ - DATA GRD253/ 0, 255, 0, 373,224, 60500, 189750, 128, 4750, - & -77250, 250, 250, 0, 0, 0, 0, 0, 0/ - DATA GRD254/ 0, 255, 1, 369,300, -35000, -250000, 128, 60789, - & -109129, 40000,40000, 20000, 64, 0, 0, 0, 0/ -C - IERR = 0 -C - DO 1 I = 1,18 - IGDS(I) = 0 - 1 CONTINUE -C - IF (IGRID.GE.37.AND.IGRID.LE.44) THEN - DO 2 I = 19,91 - IGDS(I) = 0 - 2 CONTINUE - END IF -C - IF (IGRID.GE.21.AND.IGRID.LE.24) THEN - DO I = 19,55 - IGDS(I) = 0 - END DO - END IF -C - IF (IGRID.GE.25.AND.IGRID.LE.26) THEN - DO I = 19,37 - IGDS(I) = 0 - END DO - END IF -C - IF (IGRID.GE.61.AND.IGRID.LE.64) THEN - DO I = 19,64 - IGDS(I) = 0 - END DO - END IF -C - IF (IGRID.EQ.1) THEN - DO 3 I = 1,18 - IGDS(I) = GRD1(I) - 3 CONTINUE -C - ELSE IF (IGRID.EQ.2) THEN - DO 4 I = 1,18 - IGDS(I) = GRD2(I) - 4 CONTINUE -C - ELSE IF (IGRID.EQ.3) THEN - DO 5 I = 1,18 - IGDS(I) = GRD3(I) - 5 CONTINUE -C - ELSE IF (IGRID.EQ.4) THEN - DO 6 I = 1,18 - IGDS(I) = GRD4(I) - 6 CONTINUE -C - ELSE IF (IGRID.EQ.5) THEN - DO 10 I = 1,18 - IGDS(I) = GRD5(I) - 10 CONTINUE -C - ELSE IF (IGRID.EQ.6) THEN - DO 20 I = 1,18 - IGDS(I) = GRD6(I) - 20 CONTINUE -C - ELSE IF (IGRID.EQ.8) THEN - DO I = 1,18 - IGDS(I) = GRD8(I) - END DO -C - ELSE IF (IGRID.EQ.10) THEN - DO I = 1,18 - IGDS(I) = GRD10(I) - END DO -C - ELSE IF (IGRID.EQ.11) THEN - DO I = 1,18 - IGDS(I) = GRD11(I) - END DO -C - ELSE IF (IGRID.EQ.12) THEN - DO I = 1,18 - IGDS(I) = GRD12(I) - END DO -C - ELSE IF (IGRID.EQ.13) THEN - DO I = 1,18 - IGDS(I) = GRD13(I) - END DO -C - ELSE IF (IGRID.EQ.14) THEN - DO I = 1,18 - IGDS(I) = GRD14(I) - END DO -C - ELSE IF (IGRID.EQ.15) THEN - DO I = 1,18 - IGDS(I) = GRD15(I) - END DO -C - ELSE IF (IGRID.EQ.16) THEN - DO I = 1,18 - IGDS(I) = GRD16(I) - END DO -C - ELSE IF (IGRID.EQ.17) THEN - DO I = 1,18 - IGDS(I) = GRD17(I) - END DO -C - ELSE IF (IGRID.EQ.18) THEN - DO I = 1,18 - IGDS(I) = GRD18(I) - END DO -C - ELSE IF (IGRID.EQ.21) THEN - DO 30 I = 1,55 - IGDS(I) = GRD21(I) - 30 CONTINUE -C - ELSE IF (IGRID.EQ.22) THEN - DO 40 I = 1,55 - IGDS(I) = GRD22(I) - 40 CONTINUE -C - ELSE IF (IGRID.EQ.23) THEN - DO 50 I = 1,55 - IGDS(I) = GRD23(I) - 50 CONTINUE -C - ELSE IF (IGRID.EQ.24) THEN - DO 60 I = 1,55 - IGDS(I) = GRD24(I) - 60 CONTINUE -C - ELSE IF (IGRID.EQ.25) THEN - DO 70 I = 1,37 - IGDS(I) = GRD25(I) - 70 CONTINUE -C - ELSE IF (IGRID.EQ.26) THEN - DO 80 I = 1,37 - IGDS(I) = GRD26(I) - 80 CONTINUE -C - ELSE IF (IGRID.EQ.27) THEN - DO 90 I = 1,18 - IGDS(I) = GRD27(I) - 90 CONTINUE -C - ELSE IF (IGRID.EQ.28) THEN - DO 100 I = 1,18 - IGDS(I) = GRD28(I) - 100 CONTINUE -C - ELSE IF (IGRID.EQ.29) THEN - DO 110 I = 1,18 - IGDS(I) = GRD29(I) - 110 CONTINUE -C - ELSE IF (IGRID.EQ.30) THEN - DO 120 I = 1,18 - IGDS(I) = GRD30(I) - 120 CONTINUE -C - ELSE IF (IGRID.EQ.33) THEN - DO 130 I = 1,18 - IGDS(I) = GRD33(I) - 130 CONTINUE -C - ELSE IF (IGRID.EQ.34) THEN - DO 140 I = 1,18 - IGDS(I) = GRD34(I) - 140 CONTINUE -C - ELSE IF (IGRID.EQ.37) THEN - DO 141 I = 1,91 - IGDS(I) = GRD37(I) - 141 CONTINUE -C - ELSE IF (IGRID.EQ.38) THEN - DO 142 I = 1,91 - IGDS(I) = GRD38(I) - 142 CONTINUE -C - ELSE IF (IGRID.EQ.39) THEN - DO 143 I = 1,91 - IGDS(I) = GRD39(I) - 143 CONTINUE -C - ELSE IF (IGRID.EQ.40) THEN - DO 144 I = 1,91 - IGDS(I) = GRD40(I) - 144 CONTINUE -C - ELSE IF (IGRID.EQ.41) THEN - DO 145 I = 1,91 - IGDS(I) = GRD41(I) - 145 CONTINUE -C - ELSE IF (IGRID.EQ.42) THEN - DO 146 I = 1,91 - IGDS(I) = GRD42(I) - 146 CONTINUE -C - ELSE IF (IGRID.EQ.43) THEN - DO 147 I = 1,91 - IGDS(I) = GRD43(I) - 147 CONTINUE -C - ELSE IF (IGRID.EQ.44) THEN - DO 148 I = 1,91 - IGDS(I) = GRD44(I) - 148 CONTINUE -C - ELSE IF (IGRID.EQ.45) THEN - DO 149 I = 1,18 - IGDS(I) = GRD45(I) - 149 CONTINUE -C - ELSE IF (IGRID.EQ.53) THEN - DO I = 1,18 - IGDS(I) = GRD53(I) - END DO -C - ELSE IF (IGRID.EQ.55) THEN - DO 152 I = 1,18 - IGDS(I) = GRD55(I) - 152 CONTINUE -C - ELSE IF (IGRID.EQ.56) THEN - DO 154 I = 1,18 - IGDS(I) = GRD56(I) - 154 CONTINUE -C - ELSE IF (IGRID.EQ.61) THEN - DO 160 I = 1,64 - IGDS(I) = GRD61(I) - 160 CONTINUE -C - ELSE IF (IGRID.EQ.62) THEN - DO 170 I = 1,64 - IGDS(I) = GRD62(I) - 170 CONTINUE -C - ELSE IF (IGRID.EQ.63) THEN - DO 180 I = 1,64 - IGDS(I) = GRD63(I) - 180 CONTINUE -C - ELSE IF (IGRID.EQ.64) THEN - DO 190 I = 1,64 - IGDS(I) = GRD64(I) - 190 CONTINUE -C - ELSE IF (IGRID.EQ.85) THEN - DO 192 I = 1,18 - IGDS(I) = GRD85(I) - 192 CONTINUE -C - ELSE IF (IGRID.EQ.86) THEN - DO 194 I = 1,18 - IGDS(I) = GRD86(I) - 194 CONTINUE -C - ELSE IF (IGRID.EQ.87) THEN - DO 195 I = 1,18 - IGDS(I) = GRD87(I) - 195 CONTINUE -C - ELSE IF (IGRID.EQ.88) THEN - DO 2195 I = 1,18 - IGDS(I) = GRD88(I) -2195 CONTINUE -C - ELSE IF (IGRID.EQ.90) THEN - DO 196 I = 1,18 - IGDS(I) = GRD90(I) - 196 CONTINUE -C - ELSE IF (IGRID.EQ.91) THEN - DO 197 I = 1,18 - IGDS(I) = GRD91(I) - 197 CONTINUE -C - ELSE IF (IGRID.EQ.92) THEN - DO 198 I = 1,18 - IGDS(I) = GRD92(I) - 198 CONTINUE -C - ELSE IF (IGRID.EQ.93) THEN - DO 199 I = 1,18 - IGDS(I) = GRD93(I) - 199 CONTINUE -C - ELSE IF (IGRID.EQ.94) THEN - DO 200 I = 1,18 - IGDS(I) = GRD94(I) - 200 CONTINUE -C - ELSE IF (IGRID.EQ.95) THEN - DO 201 I = 1,18 - IGDS(I) = GRD95(I) - 201 CONTINUE -C - ELSE IF (IGRID.EQ.96) THEN - DO 202 I = 1,18 - IGDS(I) = GRD96(I) - 202 CONTINUE -C - ELSE IF (IGRID.EQ.97) THEN - DO 203 I = 1,18 - IGDS(I) = GRD97(I) - 203 CONTINUE -C - ELSE IF (IGRID.EQ.98) THEN - DO 204 I = 1,18 - IGDS(I) = GRD98(I) - 204 CONTINUE -C - ELSE IF (IGRID.EQ.99) THEN - DO I = 1,18 - IGDS(I) = GRD99(I) - ENDDO -C - ELSE IF (IGRID.EQ.100) THEN - DO 205 I = 1,18 - IGDS(I) = GRD100(I) - 205 CONTINUE -C - ELSE IF (IGRID.EQ.101) THEN - DO 210 I = 1,18 - IGDS(I) = GRD101(I) - 210 CONTINUE -C - ELSE IF (IGRID.EQ.103) THEN - DO 220 I = 1,18 - IGDS(I) = GRD103(I) - 220 CONTINUE -C - ELSE IF (IGRID.EQ.104) THEN - DO 230 I = 1,18 - IGDS(I) = GRD104(I) - 230 CONTINUE -C - ELSE IF (IGRID.EQ.105) THEN - DO 240 I = 1,18 - IGDS(I) = GRD105(I) - 240 CONTINUE -C - ELSE IF (IGRID.EQ.106) THEN - DO 242 I = 1,18 - IGDS(I) = GRD106(I) - 242 CONTINUE -C - ELSE IF (IGRID.EQ.107) THEN - DO 244 I = 1,18 - IGDS(I) = GRD107(I) - 244 CONTINUE -C - ELSE IF (IGRID.EQ.110) THEN - DO I = 1,18 - IGDS(I) = GRD110(I) - ENDDO -C - ELSE IF (IGRID.EQ.120) THEN - DO I = 1,18 - IGDS(I) = GRD120(I) - ENDDO -C - ELSE IF (IGRID.EQ.122) THEN - DO I = 1,18 - IGDS(I) = GRD122(I) - ENDDO -C - ELSE IF (IGRID.EQ.123) THEN - DO I = 1,18 - IGDS(I) = GRD123(I) - ENDDO -C - ELSE IF (IGRID.EQ.124) THEN - DO I = 1,18 - IGDS(I) = GRD124(I) - ENDDO -C - ELSE IF (IGRID.EQ.125) THEN - DO I = 1,18 - IGDS(I) = GRD125(I) - ENDDO -C - ELSE IF (IGRID.EQ.126) THEN - DO 245 I = 1,18 - IGDS(I) = GRD126(I) - 245 CONTINUE -C - ELSE IF (IGRID.EQ.127) THEN - DO I = 1,18 - IGDS(I) = GRD127(I) - ENDDO -C - ELSE IF (IGRID.EQ.130) THEN - DO I = 1,18 - IGDS(I) = GRD130(I) - ENDDO -C - ELSE IF (IGRID.EQ.138) THEN - DO I = 1,18 - IGDS(I) = GRD138(I) - ENDDO -C - ELSE IF (IGRID.EQ.145) THEN - DO I = 1,18 - IGDS(I) = GRD145(I) - ENDDO -C - ELSE IF (IGRID.EQ.146) THEN - DO I = 1,18 - IGDS(I) = GRD146(I) - ENDDO -C - ELSE IF (IGRID.EQ.147) THEN - DO I = 1,18 - IGDS(I) = GRD147(I) - ENDDO -C - ELSE IF (IGRID.EQ.148) THEN - DO I = 1,18 - IGDS(I) = GRD148(I) - ENDDO -C - ELSE IF (IGRID.EQ.150) THEN - DO I = 1,18 - IGDS(I) = GRD150(I) - ENDDO -C - ELSE IF (IGRID.EQ.151) THEN - DO I = 1,18 - IGDS(I) = GRD151(I) - ENDDO -C - ELSE IF (IGRID.EQ.160) THEN - DO I = 1,18 - IGDS(I) = GRD160(I) - ENDDO -C - ELSE IF (IGRID.EQ.161) THEN - DO I = 1,18 - IGDS(I) = GRD161(I) - ENDDO - ELSE IF (IGRID.EQ.163) THEN - DO I = 1,18 - IGDS(I) = GRD163(I) - ENDDO -C - ELSE IF (IGRID.EQ.170) THEN - DO I = 1,18 - IGDS(I) = GRD170(I) - ENDDO -C - ELSE IF (IGRID.EQ.171) THEN - DO I = 1,18 - IGDS(I) = GRD171(I) - ENDDO -C - ELSE IF (IGRID.EQ.172) THEN - DO I = 1,18 - IGDS(I) = GRD172(I) - ENDDO -C - ELSE IF (IGRID.EQ.173) THEN - DO I = 1,18 - IGDS(I) = GRD173(I) - ENDDO -C - ELSE IF (IGRID.EQ.174) THEN - DO I = 1,18 - IGDS(I) = GRD174(I) - ENDDO -C - ELSE IF (IGRID.EQ.175) THEN - DO I = 1,18 - IGDS(I) = GRD175(I) - ENDDO -C - ELSE IF (IGRID.EQ.176) THEN - DO I = 1,18 - IGDS(I) = GRD176(I) - ENDDO -C - ELSE IF (IGRID.EQ.180) THEN - DO I = 1,18 - IGDS(I) = GRD180(I) - ENDDO -C - ELSE IF (IGRID.EQ.181) THEN - DO I = 1,18 - IGDS(I) = GRD181(I) - ENDDO -C - ELSE IF (IGRID.EQ.182) THEN - DO I = 1,18 - IGDS(I) = GRD182(I) - ENDDO -C - ELSE IF (IGRID.EQ.183) THEN - DO I = 1,18 - IGDS(I) = GRD183(I) - ENDDO -C - ELSE IF (IGRID.EQ.190) THEN - DO 2190 I = 1,18 - IGDS(I) = GRD190(I) - 2190 CONTINUE -C - ELSE IF (IGRID.EQ.192) THEN - DO 2191 I = 1,18 - IGDS(I) = GRD192(I) - 2191 CONTINUE -C - ELSE IF (IGRID.EQ.194) THEN - DO 2192 I = 1,18 - IGDS(I) = GRD194(I) - 2192 CONTINUE -C - ELSE IF (IGRID.EQ.195) THEN - DO I = 1,18 - IGDS(I) = GRD195(I) - END DO -C - ELSE IF (IGRID.EQ.196) THEN - DO 249 I = 1,18 - IGDS(I) = GRD196(I) - 249 CONTINUE -C - ELSE IF (IGRID.EQ.197) THEN - DO I = 1,18 - IGDS(I) = GRD197(I) - END DO -C - ELSE IF (IGRID.EQ.198) THEN - DO 2490 I = 1,18 - IGDS(I) = GRD198(I) - 2490 CONTINUE -C - ELSE IF (IGRID.EQ.201) THEN - DO 250 I = 1,18 - IGDS(I) = GRD201(I) - 250 CONTINUE -C - ELSE IF (IGRID.EQ.202) THEN - DO 260 I = 1,18 - IGDS(I) = GRD202(I) - 260 CONTINUE -C - ELSE IF (IGRID.EQ.203) THEN - DO 270 I = 1,18 - IGDS(I) = GRD203(I) - 270 CONTINUE -C - ELSE IF (IGRID.EQ.204) THEN - DO 280 I = 1,18 - IGDS(I) = GRD204(I) - 280 CONTINUE -C - ELSE IF (IGRID.EQ.205) THEN - DO 290 I = 1,18 - IGDS(I) = GRD205(I) - 290 CONTINUE -C - ELSE IF (IGRID.EQ.206) THEN - DO 300 I = 1,18 - IGDS(I) = GRD206(I) - 300 CONTINUE -C - ELSE IF (IGRID.EQ.207) THEN - DO 310 I = 1,18 - IGDS(I) = GRD207(I) - 310 CONTINUE -C - ELSE IF (IGRID.EQ.208) THEN - DO 320 I = 1,18 - IGDS(I) = GRD208(I) - 320 CONTINUE -C - ELSE IF (IGRID.EQ.209) THEN - DO 330 I = 1,18 - IGDS(I) = GRD209(I) - 330 CONTINUE -C - ELSE IF (IGRID.EQ.210) THEN - DO 340 I = 1,18 - IGDS(I) = GRD210(I) - 340 CONTINUE -C - ELSE IF (IGRID.EQ.211) THEN - DO 350 I = 1,18 - IGDS(I) = GRD211(I) - 350 CONTINUE -C - ELSE IF (IGRID.EQ.212) THEN - DO 360 I = 1,18 - IGDS(I) = GRD212(I) - 360 CONTINUE -C - ELSE IF (IGRID.EQ.213) THEN - DO 370 I = 1,18 - IGDS(I) = GRD213(I) - 370 CONTINUE -C - ELSE IF (IGRID.EQ.214) THEN - DO 380 I = 1,18 - IGDS(I) = GRD214(I) - 380 CONTINUE -C - ELSE IF (IGRID.EQ.215) THEN - DO 390 I = 1,18 - IGDS(I) = GRD215(I) - 390 CONTINUE -C - ELSE IF (IGRID.EQ.216) THEN - DO 400 I = 1,18 - IGDS(I) = GRD216(I) - 400 CONTINUE -C - ELSE IF (IGRID.EQ.217) THEN - DO 401 I = 1,18 - IGDS(I) = GRD217(I) - 401 CONTINUE -C - ELSE IF (IGRID.EQ.218) THEN - DO 410 I = 1,18 - IGDS(I) = GRD218(I) - 410 CONTINUE -C - ELSE IF (IGRID.EQ.219) THEN - DO 411 I = 1,18 - IGDS(I) = GRD219(I) - 411 CONTINUE -C - ELSE IF (IGRID.EQ.220) THEN - DO 412 I = 1,18 - IGDS(I) = GRD220(I) - 412 CONTINUE -C - ELSE IF (IGRID.EQ.221) THEN - DO 413 I = 1,18 - IGDS(I) = GRD221(I) - 413 CONTINUE -C - ELSE IF (IGRID.EQ.222) THEN - DO 414 I = 1,18 - IGDS(I) = GRD222(I) - 414 CONTINUE -C - ELSE IF (IGRID.EQ.223) THEN - DO 415 I = 1,18 - IGDS(I) = GRD223(I) - 415 CONTINUE -C - ELSE IF (IGRID.EQ.224) THEN - DO 416 I = 1,18 - IGDS(I) = GRD224(I) - 416 CONTINUE -C - ELSE IF (IGRID.EQ.225) THEN - DO 417 I = 1,18 - IGDS(I) = GRD225(I) - 417 CONTINUE -C - ELSE IF (IGRID.EQ.226) THEN - DO 418 I = 1,18 - IGDS(I) = GRD226(I) - 418 CONTINUE -C - ELSE IF (IGRID.EQ.227) THEN - DO 419 I = 1,18 - IGDS(I) = GRD227(I) - 419 CONTINUE -C - ELSE IF (IGRID.EQ.228) THEN - DO 420 I = 1,18 - IGDS(I) = GRD228(I) - 420 CONTINUE -C - ELSE IF (IGRID.EQ.229) THEN - DO 421 I = 1,18 - IGDS(I) = GRD229(I) - 421 CONTINUE -C - ELSE IF (IGRID.EQ.230) THEN - DO 422 I = 1,18 - IGDS(I) = GRD230(I) - 422 CONTINUE -C - ELSE IF (IGRID.EQ.231) THEN - DO 423 I = 1,18 - IGDS(I) = GRD231(I) - 423 CONTINUE -C - ELSE IF (IGRID.EQ.232) THEN - DO 424 I = 1,18 - IGDS(I) = GRD232(I) - 424 CONTINUE -C - ELSE IF (IGRID.EQ.233) THEN - DO 425 I = 1,18 - IGDS(I) = GRD233(I) - 425 CONTINUE -C - ELSE IF (IGRID.EQ.234) THEN - DO 426 I = 1,18 - IGDS(I) = GRD234(I) - 426 CONTINUE -C - ELSE IF (IGRID.EQ.235) THEN - DO 427 I = 1,18 - IGDS(I) = GRD235(I) - 427 CONTINUE -C - ELSE IF (IGRID.EQ.236) THEN - DO 428 I = 1,18 - IGDS(I) = GRD236(I) - 428 CONTINUE -C - ELSE IF (IGRID.EQ.237) THEN - DO 429 I = 1,18 - IGDS(I) = GRD237(I) - 429 CONTINUE -C - ELSE IF (IGRID.EQ.238) THEN - DO I = 1,18 - IGDS(I) = GRD238(I) - END DO -C - ELSE IF (IGRID.EQ.239) THEN - DO I = 1,18 - IGDS(I) = GRD239(I) - END DO -C - ELSE IF (IGRID.EQ.240) THEN - DO I = 1,18 - IGDS(I) = GRD240(I) - END DO -C - ELSE IF (IGRID.EQ.241) THEN - DO 430 I = 1,18 - IGDS(I) = GRD241(I) - 430 CONTINUE -C - ELSE IF (IGRID.EQ.242) THEN - DO 431 I = 1,18 - IGDS(I) = GRD242(I) - 431 CONTINUE -C - ELSE IF (IGRID.EQ.243) THEN - DO 432 I = 1,18 - IGDS(I) = GRD243(I) - 432 CONTINUE -C - ELSE IF (IGRID.EQ.244) THEN - DO I = 1,18 - IGDS(I) = GRD244(I) - END DO -C - ELSE IF (IGRID.EQ.245) THEN - DO 433 I = 1,18 - IGDS(I) = GRD245(I) - 433 CONTINUE -C - ELSE IF (IGRID.EQ.246) THEN - DO 434 I = 1,18 - IGDS(I) = GRD246(I) - 434 CONTINUE -C - ELSE IF (IGRID.EQ.247) THEN - DO 435 I = 1,18 - IGDS(I) = GRD247(I) - 435 CONTINUE -C - ELSE IF (IGRID.EQ.248) THEN - DO 436 I = 1,18 - IGDS(I) = GRD248(I) - 436 CONTINUE -C - ELSE IF (IGRID.EQ.249) THEN - DO 437 I = 1,18 - IGDS(I) = GRD249(I) - 437 CONTINUE -C - ELSE IF (IGRID.EQ.250) THEN - DO 438 I = 1,18 - IGDS(I) = GRD250(I) - 438 CONTINUE -C - ELSE IF (IGRID.EQ.251) THEN - DO 439 I = 1,18 - IGDS(I) = GRD251(I) - 439 CONTINUE -C - ELSE IF (IGRID.EQ.252) THEN - DO 440 I = 1,18 - IGDS(I) = GRD252(I) - 440 CONTINUE - ELSE IF (IGRID.EQ.253) THEN - DO 441 I = 1,18 - IGDS(I) = GRD253(I) - 441 CONTINUE - ELSE IF (IGRID.EQ.254) THEN - DO 442 I = 1,18 - IGDS(I) = GRD254(I) - 442 CONTINUE -C - ELSE - IERR = 1 - ENDIF -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi72.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi72.f deleted file mode 100755 index b20f7838a4..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi72.f +++ /dev/null @@ -1,445 +0,0 @@ - SUBROUTINE W3FI72(ITYPE,FLD,IFLD,IBITL, - & IPFLAG,ID,PDS, - & IGFLAG,IGRID,IGDS,ICOMP, - & IBFLAG,IBMAP,IBLEN,IBDSFL, - & NPTS,KBUF,ITOT,JERR) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI72 MAKE A COMPLETE GRIB MESSAGE -C PRGMMR: FARLEY ORG: NMC421 DATE:94-11-22 -C -C ABSTRACT: MAKES A COMPLETE GRIB MESSAGE FROM A USER SUPPLIED -C ARRAY OF FLOATING POINT OR INTEGER DATA. THE USER HAS THE -C OPTION OF SUPPLYING THE PDS OR AN INTEGER ARRAY THAT WILL BE -C USED TO CREATE A PDS (WITH W3FI68). THE USER MUST ALSO -C SUPPLY OTHER NECESSARY INFO; SEE USAGE SECTION BELOW. -C -C PROGRAM HISTORY LOG: -C 91-05-08 R.E.JONES -C 92-07-01 M. FARLEY ADDED GDS AND BMS LOGIC. PLACED EXISTING -C LOGIC FOR BDS IN A ROUTINE. -C 92-10-02 R.E.JONES ADD ERROR EXIT FOR W3FI73 -C 93-04-30 R.E.JONES REPLACE DO LOOPS TO MOVE CHARACTER DATA -C WITH XMOVEX, USE XSTORE TO ZERO CHARACTER -C ARRAY. MAKE CHANGE SO FLAT FIELD WILL PACK. -C 93-08-06 CAVANAUGH MODIFIED CALL TO W3FI75 -C 93-10-26 CAVANAUGH ADDED CODE TO RESTORE INPUT FIELD TO ORIGINAL -C VALUES IF D-SCALE NOT 0 -C 94-01-27 CAVANAUGH ADDED IGDS ARRAY IN CALL TO W3FI75 TO PROVIDE -C INFORMATION FOR BOUSTROPHEDONIC PROCESSING -C 94-03-03 CAVANAUGH INCREASED SIZE OF GDS ARRAY FOR THIN GRIDS -C 94-05-16 FARLEY CLEANED UP DOCUMENTATION -C 94-11-10 FARLEY INCREASED SIZE OF PFLD/IFLD ARRARYS FROM -C 100K TO 260K FOR .5 DEGREE SST ANAL FIELDS -C 94-12-04 R.E.JONES CHANGE DOCUMENT FOR IPFLAG. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-05-19 Gilbert Increased array dimensions to handle grids -C of up to 500,000 grid points. -C 95-10-31 IREDELL GENERALIZED WORD SIZE -C 98-12-21 Gilbert Replaced Function ICHAR with mova2i. -C 99-02-01 Gilbert Changed the method of zeroing out array KBUF. -C the old method, using W3FI01 and XSTORE was -C incorrect with 4-byte integers and 8-byte reals. -C 2001-06-07 Gilbert Removed calls to xmovex. -C changed IPFLD from integer to character. -C -C USAGE: CALL W3FI72(ITYPE,FLD,IFLD,IBITL, -C & IPFLAG,ID,PDS, -C & IGFLAG,IGRID,IGDS,ICOMP, -C & IBFLAG,IBMAP,IBLEN,IBDSFL, -C & IBDSFL, -C & NPTS,KBUF,ITOT,JERR) -C -C INPUT ARGUMENT LIST: -C ITYPE - 0 = FLOATING POINT DATA SUPPLIED IN ARRAY 'FLD' -C 1 = INTEGER DATA SUPPLIED IN ARRAY 'IFLD' -C FLD - REAL ARRAY OF DATA (AT PROPER GRIDPOINTS) TO BE -C CONVERTED TO GRIB FORMAT IF ITYPE=0. -C SEE REMARKS #1 & 2. -C IFLD - INTEGER ARRAY OF DATA (AT PROPER GRIDPOINTS) TO BE -C CONVERTED TO GRIB FORMAT IF ITYPE=1. -C SEE REMARKS #1 & 2. -C IBITL - 0 = COMPUTER COMPUTES LENGTH FOR PACKING DATA FROM -C POWER OF 2 (NUMBER OF BITS) BEST FIT OF DATA -C USING 'VARIABLE' BIT PACKER W3FI58. -C 8, 12, ETC. COMPUTER RESCALES DATA TO FIT INTO THAT -C 'FIXED' NUMBER OF BITS USING W3FI59. -C SEE REMARKS #3. -C -C IPFLAG - 0 = MAKE PDS FROM USER SUPPLIED ARRAY (ID) -C 1 = USER SUPPLYING PDS -C NOTE: IF PDS IS GREATER THAN 30, USE IPLFAG=1. -C THE USER COULD CALL W3FI68 BEFORE HE CALLS -C W3FI72. THIS WOULD MAKE THE FIRST 30 BYTES OF -C THE PDS, USER THEN WOULD MAKE BYTES AFTER 30. -C ID - INTEGER ARRAY OF VALUES THAT W3FI68 WILL USE -C TO MAKE AN EDITION 1 PDS IF IPFLAG=0. (SEE THE -C DOCBLOCK FOR W3FI68 FOR LAYOUT OF ARRAY) -C PDS - CHARACTER ARRAY OF VALUES (VALID PDS SUPPLIED -C BY USER) IF IPFLAG=1. LENGTH MAY EXCEED 28 BYTES -C (CONTENTS OF BYTES BEYOND 28 ARE PASSED -C THROUGH UNCHANGED). -C -C IGFLAG - 0 = MAKE GDS BASED ON 'IGRID' VALUE. -C 1 = MAKE GDS FROM USER SUPPLIED INFO IN 'IGDS' -C AND 'IGRID' VALUE. -C SEE REMARKS #4. -C IGRID - # = GRID IDENTIFICATION (TABLE B) -C 255 = IF USER DEFINED GRID; IGDS MUST BE SUPPLIED -C AND IGFLAG MUST =1. -C IGDS - INTEGER ARRAY CONTAINING USER GDS INFO (SAME -C FORMAT AS SUPPLIED BY W3FI71 - SEE DOCKBLOCK FOR -C LAYOUT) IF IGFLAG=1. -C ICOMP - RESOLUTION AND COMPONENT FLAG FOR BIT 5 OF GDS(17) -C 0 = EARTH ORIENTED WINDS -C 1 = GRID ORIENTED WINDS -C -C IBFLAG - 0 = MAKE BIT MAP FROM USER SUPPLIED DATA -C # = BIT MAP PREDEFINED BY CENTER -C SEE REMARKS #5. -C IBMAP - INTEGER ARRAY CONTAINING BIT MAP -C IBLEN - LENGTH OF BIT MAP WILL BE USED TO VERIFY LENGTH -C OF FIELD (ERROR IF IT DOESN'T MATCH). -C -C IBDSFL - INTEGER ARRAY CONTAINING TABLE 11 FLAG INFO -C BDS OCTET 4: -C (1) 0 = GRID POINT DATA -C 1 = SPHERICAL HARMONIC COEFFICIENTS -C (2) 0 = SIMPLE PACKING -C 1 = SECOND ORDER PACKING -C (3) ... SAME VALUE AS 'ITYPE' -C 0 = ORIGINAL DATA WERE FLOATING POINT VALUES -C 1 = ORIGINAL DATA WERE INTEGER VALUES -C (4) 0 = NO ADDITIONAL FLAGS AT OCTET 14 -C 1 = OCTET 14 CONTAINS FLAG BITS 5-12 -C (5) 0 = RESERVED - ALWAYS SET TO 0 -C BYTE 6 OPTION 1 NOT AVAILABLE (AS OF 5-16-93) -C (6) 0 = SINGLE DATUM AT EACH GRID POINT -C 1 = MATRIX OF VALUES AT EACH GRID POINT -C BYTE 7 OPTION 0 WITH SECOND ORDER PACKING N/A (AS OF 5-16-93) -C (7) 0 = NO SECONDARY BIT MAPS -C 1 = SECONDARY BIT MAPS PRESENT -C (8) 0 = SECOND ORDER VALUES HAVE CONSTANT WIDTH -C 1 = SECOND ORDER VALUES HAVE DIFFERENT WIDTHS -C -C OUTPUT ARGUMENT LIST: -C NPTS - NUMBER OF GRIDPOINTS IN ARRAY FLD OR IFLD -C KBUF - ENTIRE GRIB MESSAGE ('GRIB' TO '7777') -C EQUIVALENCE TO INTEGER ARRAY TO MAKE SURE IT -C IS ON WORD BOUNARY. -C ITOT - TOTAL LENGTH OF GRIB MESSAGE IN BYTES -C JERR - = 0, COMPLETED MAKING GRIB FIELD WITHOUT ERROR -C 1, IPFLAG NOT 0 OR 1 -C 2, IGFLAG NOT 0 OR 1 -C 3, ERROR CONVERTING IEEE F.P. NUMBER TO IBM370 F.P. -C 4, W3FI71 ERROR/IGRID NOT DEFINED -C 5, W3FK74 ERROR/GRID REPRESENTATION TYPE NOT VALID -C 6, GRID TOO LARGE FOR PACKER DIMENSION ARRAYS -C SEE AUTOMATION DIVISION FOR REVISION! -C 7, LENGTH OF BIT MAP NOT EQUAL TO SIZE OF FLD/IFLD -C 8, W3FI73 ERROR, ALL VALUES IN IBMAP ARE ZERO -C -C OUTPUT FILES: -C FT06F001 - STANDARD FORTRAN OUTPUT PRINT FILE -C -C SUBPROGRAMS CALLED: -C LIBRARY: -C W3LIB - W3FI58, W3FI59, W3FI68, W3FI71, W3FI73, W3FI74 -C W3FI75, W3FI76 -C FORTRAN 90 INTRINSIC - BIT_SIZE -C -C REMARKS: -C 1) IF BIT MAP TO BE INCLUDED IN MESSAGE, NULL DATA SHOULD -C BE INCLUDED IN FLD OR IFLD. THIS ROUTINE WILL TAKE CARE -C OF 'DISCARDING' ANY NULL DATA BASED ON THE BIT MAP. -C 2) UNITS MUST BE THOSE IN GRIB DOCUMENTATION: NMC O.N. 388 -C OR WMO PUBLICATION 306. -C 3) IN EITHER CASE, INPUT NUMBERS WILL BE MULTIPLIED BY -C '10 TO THE NTH' POWER FOUND IN ID(25) OR PDS(27-28), -C THE D-SCALING FACTOR, PRIOR TO BINARY PACKING. -C 4) ALL NMC PRODUCED GRIB FIELDS WILL HAVE A GRID DEFINITION -C SECTION INCLUDED IN THE GRIB MESSAGE. ID(6) WILL BE -C SET TO '1'. -C - GDS WILL BE BUILT BASED ON GRID NUMBER (IGRID), UNLESS -C IGFLAG=1 (USER SUPPLYING IGDS). USER MUST STILL SUPPLY -C IGRID EVEN IF IGDS PROVIDED. -C 5) IF BIT MAP USED THEN ID(7) OR PDS(8) MUST INDICATE THE -C PRESENCE OF A BIT MAP. -C 6) ARRAY KBUF SHOULD BE EQUIVALENCED TO AN INTEGER VALUE OR -C ARRAY TO MAKE SURE IT IS ON A WORD BOUNDARY. -C 7) SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ -C - REAL FLD(*) -C - INTEGER IBDSFL(*) - INTEGER IBMAP(*) - INTEGER ID(*) - INTEGER IFLD(*) - INTEGER IGDS(*) - INTEGER IB(4) -C - CHARACTER * 1 BDS11(11) - CHARACTER * 1 KBUF(*) - CHARACTER * 1 PDS(*) - CHARACTER * 1 GDS(200) - CHARACTER(1),ALLOCATABLE:: BMS(:) - CHARACTER(1),ALLOCATABLE:: PFLD(:) - CHARACTER(1),ALLOCATABLE:: IPFLD(:) - CHARACTER * 1 SEVEN - CHARACTER * 1 ZERO -C -C -C ASCII REP OF /'G', 'R', 'I', 'B'/ -C - DATA IB / 71, 82, 73, 66/ -C - IER = 0 - IBERR = 0 - JERR = 0 - IGRIBL = 8 - IPDSL = 0 - LENGDS = 0 - LENBMS = 0 - LENBDS = 0 - ITOSS = 0 -C -C$ 1.0 PRODUCT DEFINITION SECTION(PDS). -C -C SET ID(6) TO 1 ...OR... MODIFY PDS(8) ... -C REGARDLESS OF USER SPECIFICATION... -C NMC GRIB FIELDS WILL ALWAYS HAVE A GDS -C - IF (IPFLAG .EQ.0) THEN - ID(6) = 1 - CALL W3FI68(ID,PDS) - ELSE IF (IPFLAG .EQ. 1) THEN - IF (IAND(mova2i(PDS(8)),64) .EQ. 64) THEN -C BOTH GDS AND BMS - PDS(8) = CHAR(192) - ELSE IF (mova2i(PDS(8)) .EQ. 0) THEN -C GDS ONLY - PDS(8) = CHAR(128) - END IF - CONTINUE - ELSE -C PRINT *,' W3FI72 ERROR, IPFLAG IS NOT 0 OR 1 IPFLAG = ',IPFLAG - JERR = 1 - GO TO 900 - END IF -C -C GET LENGTH OF PDS -C - IPDSL = mova2i(PDS(1)) * 65536 + mova2i(PDS(2)) * 256 + - & mova2i(PDS(3)) -C -C$ 2.0 GRID DEFINITION SECTION (GDS). -C -C IF IGFLAG=1 THEN USER IS SUPPLYING THE IGDS INFORMATION -C - IF (IGFLAG .EQ. 0) THEN - CALL W3FI71(IGRID,IGDS,IGERR) - IF (IGERR .EQ. 1) THEN -C PRINT *,' W3FI71 ERROR, GRID TYPE NOT DEFINED...',IGRID - JERR = 4 - GO TO 900 - END IF - END IF - IF (IGFLAG .EQ. 0 .OR. IGFLAG .EQ.1) THEN - CALL W3FI74(IGDS,ICOMP,GDS,LENGDS,NPTS,IGERR) - IF (IGERR .EQ. 1) THEN -C PRINT *,' W3FI74 ERROR, GRID REP TYPE NOT VALID...',IGDS(3) - JERR = 5 - GO TO 900 - ELSE - END IF - ELSE -C PRINT *,' W3FI72 ERROR, IGFLAG IS NOT 0 OR 1 IGFLAG = ',IGFLAG - JERR = 2 - GO TO 900 - END IF -C -C$ 3.0 BIT MAP SECTION (BMS). -C -C SET ITOSS=1 IF BITMAP BEING USED. W3FI75 WILL TOSS DATA -C PRIOR TO PACKING. LATER CODING WILL BE NEEDED WHEN THE -C 'PREDEFINED' GRIDS ARE FINALLY 'DEFINED'. -C - IF (mova2i(PDS(8)) .EQ. 64 .OR. - & mova2i(PDS(8)) .EQ. 192) THEN - ITOSS = 1 - IF (IBFLAG .EQ. 0) THEN - IF (IBLEN .NE. NPTS) THEN -C PRINT *,' W3FI72 ERROR, IBLEN .NE. NPTS = ',IBLEN,NPTS - JERR = 7 - GO TO 900 - END IF - ALLOCATE(BMS(NPTS/8+8)) - CALL W3FI73(IBFLAG,IBMAP,IBLEN,BMS,LENBMS,IER) - IF (IER .NE. 0) THEN -C PRINT *,' W3FI73 ERROR, IBMAP VALUES ARE ALL ZERO' - JERR = 8 - GO TO 900 - END IF - ELSE -C PRINT *,' BIT MAP PREDEFINED BY CENTER, IBFLAG = ',IBFLAG - END IF - END IF -C -C$ 4.0 BINARY DATA SECTION (BDS). -C -C$ 4.1 SCALE THE DATA WITH D-SCALE FROM PDS(27-28) -C - JSCALE = mova2i(PDS(27)) * 256 + mova2i(PDS(28)) - IF (IAND(JSCALE,32768).NE.0) THEN - JSCALE = - IAND(JSCALE,32767) - END IF - SCALE = 10.0 ** JSCALE - IF (ITYPE .EQ. 0) THEN - DO 410 I = 1,NPTS - FLD(I) = FLD(I) * SCALE - 410 CONTINUE - ELSE - DO 411 I = 1,NPTS - IFLD(I) = NINT(FLOAT(IFLD(I)) * SCALE) - 411 CONTINUE - END IF -C -C$ 4.2 CALL W3FI75 TO PACK DATA AND MAKE BDS. -C - ALLOCATE(PFLD(NPTS*4)) -C - IF(IBDSFL(2).NE.0) THEN - ALLOCATE(IPFLD(NPTS*4)) - IPFLD=char(0) - ELSE - ALLOCATE(IPFLD(1)) - ENDIF -C - CALL W3FI75(IBITL,ITYPE,ITOSS,FLD,IFLD,IBMAP,IBDSFL, - & NPTS,BDS11,IPFLD,PFLD,LEN,LENBDS,IBERR,PDS,IGDS) -C - IF(IBDSFL(2).NE.0) THEN -C CALL XMOVEX(PFLD,IPFLD,NPTS*4) - do ii = 1, NPTS*4 - PFLD(ii) = IPFLD(ii) - enddo - ENDIF - DEALLOCATE(IPFLD) -C - IF (IBERR .EQ. 1) THEN - JERR = 3 - GO TO 900 - END IF -C 4.3 IF D-SCALE NOT 0, RESCALE INPUT FIELD TO -C ORIGINAL VALUE -C - IF (JSCALE.NE.0) THEN - DSCALE = 1.0 / SCALE - IF (ITYPE.EQ.0) THEN - DO 412 I = 1, NPTS - FLD(I) = FLD(I) * DSCALE - 412 CONTINUE - ELSE - DO 413 I = 1, NPTS - FLD(I) = NINT(FLOAT(IFLD(I)) * DSCALE) - 413 CONTINUE - END IF - END IF -C -C$ 5.0 OUTPUT SECTION. -C -C$ 5.1 ZERO OUT THE OUTPUT ARRAY KBUF. -C - ZERO = CHAR(00) - ITOT = IGRIBL + IPDSL + LENGDS + LENBMS + LENBDS + 4 -C PRINT *,'IGRIBL =',IGRIBL -C PRINT *,'IPDSL =',IPDSL -C PRINT *,'LENGDS =',LENGDS -C PRINT *,'LENBMS =',LENBMS -C PRINT *,'LENBDS =',LENBDS -C PRINT *,'ITOT =',ITOT - KBUF(1:ITOT)=ZERO -C -C$ 5.2 MOVE SECTION 0 - 'IS' INTO KBUF (8 BYTES). -C - ISTART = 0 - DO 520 I = 1,4 - KBUF(I) = CHAR(IB(I)) - 520 CONTINUE -C - KBUF(5) = CHAR(MOD(ITOT / 65536,256)) - KBUF(6) = CHAR(MOD(ITOT / 256,256)) - KBUF(7) = CHAR(MOD(ITOT ,256)) - KBUF(8) = CHAR(1) -C -C$ 5.3 MOVE SECTION 1 - 'PDS' INTO KBUF (28 BYTES). -C - ISTART = ISTART + IGRIBL - IF (IPDSL.GT.0) THEN -C CALL XMOVEX(KBUF(ISTART+1),PDS,IPDSL) - do ii = 1, IPDSL - KBUF(ISTART+ii) = PDS(ii) - enddo - ELSE -C PRINT *,'LENGTH OF PDS LESS OR EQUAL 0, IPDSL = ',IPDSL - END IF -C -C$ 5.4 MOVE SECTION 2 - 'GDS' INTO KBUF. -C - ISTART = ISTART + IPDSL - IF (LENGDS .GT. 0) THEN -C CALL XMOVEX(KBUF(ISTART+1),GDS,LENGDS) - do ii = 1, LENGDS - KBUF(ISTART+ii) = GDS(ii) - enddo - END IF -C -C$ 5.5 MOVE SECTION 3 - 'BMS' INTO KBUF. -C - ISTART = ISTART + LENGDS - IF (LENBMS .GT. 0) THEN -C CALL XMOVEX(KBUF(ISTART+1),BMS,LENBMS) - do ii = 1, LENBMS - KBUF(ISTART+ii) = BMS(ii) - enddo - END IF -C -C$ 5.6 MOVE SECTION 4 - 'BDS' INTO KBUF. -C -C$ MOVE THE FIRST 11 OCTETS OF THE BDS INTO KBUF. -C - ISTART = ISTART + LENBMS -C CALL XMOVEX(KBUF(ISTART+1),BDS11,11) - do ii = 1, 11 - KBUF(ISTART+ii) = BDS11(ii) - enddo -C -C$ MOVE THE PACKED DATA INTO THE KBUF -C - ISTART = ISTART + 11 - IF (LEN.GT.0) THEN -C CALL XMOVEX(KBUF(ISTART+1),PFLD,LEN) - do ii = 1, LEN - KBUF(ISTART+ii) = PFLD(ii) - enddo - END IF -C -C$ ADD '7777' TO END OFF KBUF -C NOTE THAT THESE 4 OCTETS NOT INCLUDED IN ACTUAL SIZE OF BDS. -C - SEVEN = CHAR(55) - ISTART = ITOT - 4 - DO 562 I = 1,4 - KBUF(ISTART+I) = SEVEN - 562 CONTINUE -C - 900 CONTINUE - IF(ALLOCATED(BMS)) DEALLOCATE(BMS) - IF(ALLOCATED(PFLD)) DEALLOCATE(PFLD) - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi73.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi73.f deleted file mode 100755 index 629373c8c9..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi73.f +++ /dev/null @@ -1,100 +0,0 @@ - SUBROUTINE W3FI73 (IBFLAG,IBMAP,IBLEN,BMS,LENBMS,IER) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI73 CONSTRUCT GRIB BIT MAP SECTION (BMS) -C PRGMMR: FARLEY ORG: NMC421 DATE:92-11-16 -C -C ABSTRACT: THIS SUBROUTINE CONSTRUCTS A GRIB BIT MAP SECTION. -C -C PROGRAM HISTORY LOG: -C 92-07-01 M. FARLEY ORIGINAL AUTHOR -C 94-02-14 CAVANAUGH RECODED -C 98-06-30 EBISUZAKI LINUX PORT -C -C USAGE: CALL W3FI73 (IBFLAG, IBMAP, IBLEN, BMS, LENBMS, IER) -C INPUT ARGUMENT LIST: -C IBFLAG - 0, IF BIT MAP SUPPLIED BY USER -C - #, NUMBER OF PREDEFINED CENTER BIT MAP -C IBMAP - INTEGER ARRAY CONTAINING USER BIT MAP -C IBLEN - LENGTH OF BIT MAP -C -C OUTPUT ARGUMENT LIST: -C BMS - COMPLETED GRIB BIT MAP SECTION -C LENBMS - LENGTH OF BIT MAP SECTION -C IER - 0 NORMAL EXIT, 8 = IBMAP VALUES ARE ALL ZERO -C -C SUBPROGRAMS CALLED: -C LIBRARY: -C W3LIB - SBYTE -C -C ATTRIBUTES: -C LANGUAGE: IBM370 VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, CRAY J916/2048 -C -C$$$ -C - INTEGER IBMAP(*) - INTEGER LENBMS - INTEGER IBLEN - INTEGER IBFLAG -C - CHARACTER*1 BMS(*) -C - IER = 0 -C - IZ = 0 - DO 20 I = 1, IBLEN - IF (IBMAP(I).EQ.0) IZ = IZ + 1 - 20 CONTINUE - IF (IZ.EQ.IBLEN) THEN -C -C AT THIS POINT ALL BIT MAP POSITIONS ARE ZERO -C - IER = 8 - RETURN - END IF -C -C BIT MAP IS A COMBINATION OF ONES AND ZEROS -C OR BIT MAP ALL ONES -C -C CONSTRUCT BIT MAP FIELD OF BIT MAP SECTION -C - CALL SBYTESC(BMS,IBMAP,48,1,0,IBLEN) -C - IF (MOD(IBLEN,16).NE.0) THEN - NLEFT = 16 - MOD(IBLEN,16) - ELSE - NLEFT = 0 - END IF -C - NUM = 6 + (IBLEN+NLEFT) / 8 -C -C CONSTRUCT BMS FROM COLLECTED DATA -C -C SIZE INTO FIRST THREE BYTES -C - CALL SBYTEC(BMS,NUM,0,24) -C NUMBER OF FILL BITS INTO BYTE 4 - CALL SBYTEC(BMS,NLEFT,24,8) -C OCTET 5-6 TO CONTAIN INFO FROM IBFLAG - CALL SBYTEC(BMS,IBFLAG,32,16) -C -C BIT MAP MAY BE ALL ONES OR A COMBINATION -C OF ONES AND ZEROS -C -C ACTUAL BITS OF BIT MAP PLACED ALL READY -C -C INSTALL FILL POSITIONS IF NEEDED - IF (NLEFT.NE.0) THEN - NLEFT = 16 - NLEFT -C ZERO FILL POSITIONS - CALL SBYTEC(BMS,0,IBLEN+48,NLEFT) - END IF -C -C STORE NUM IN LENBMS (LENGTH OF BMS SECTION) -C - LENBMS = NUM -C PRINT *,'W3FI73 - BMS LEN =',NUM,LENBMS -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi74.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi74.f deleted file mode 100755 index 2c6bd6f50f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi74.f +++ /dev/null @@ -1,360 +0,0 @@ - SUBROUTINE W3FI74 (IGDS,ICOMP,GDS,LENGDS,NPTS,IGERR) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI74 CONSTRUCT GRID DEFINITION SECTION (GDS) -C PRGMMR: FARLEY ORG: W/NMC42 DATE: 93-08-24 -C -C ABSTRACT: THIS SUBROUTINE CONSTRUCTS A GRIB GRID DEFINITION -C SECTION. -C -C PROGRAM HISTORY LOG: -C 92-07-07 M. FARLEY ORIGINAL AUTHOR -C 92-10-16 R.E.JONES ADD CODE TO LAT/LON SECTION TO DO -C GAUSSIAN GRIDS. -C 93-03-29 R.E.JONES ADD SAVE STATEMENT -C 93-08-24 R.E.JONES CHANGES FOR GRIB GRIDS 37-44 -C 93-09-29 R.E.JONES CHANGES FOR GAUSSIAN GRID FOR DOCUMENT -C CHANGE IN W3FI71. -C 94-02-15 R.E.JONES CHANGES FOR ETA MODEL GRIDS 90-93 -C 95-04-20 R.E.JONES CHANGE 200 AND 201 TO 201 AND 202 -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-08-20 BALDWIN ADD TYPE 203 -C 07-03-20 VUONG ADD TYPE 204 -C -C -C USAGE: CALL W3FI74 (IGDS, ICOMP, GDS, LENGDS, NPTS, IGERR) -C INPUT ARGUMENT LIST: -C IGDS - INTEGER ARRAY SUPPLIED BY W3FI71 -C ICOMP - TABLE 7- RESOLUTION & COMPONENT FLAG (BIT 5) -C FOR GDS(17) WIND COMPONENTS -C -C OUTPUT ARGUMENT LIST: -C GDS - COMPLETED GRIB GRID DEFINITION SECTION -C LENGDS - LENGTH OF GDS -C NPTS - NUMBER OF POINTS IN GRID -C IGERR - 1, GRID REPRESENTATION TYPE NOT VALID -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: CRAY CFT77 FORTRAN 77, IBM370 VS FORTRAN -C MACHINE: CRAY C916-128, CRAY Y-MP8/864, CRAY Y-MP EL2/256, HDS -C -C$$$ -C - INTEGER IGDS (*) -C - CHARACTER*1 GDS (*) -C - ISUM = 0 - IGERR = 0 -C -C PRINT *,' ' -C PRINT *,'(W3FI74-IGDS = )' -C PRINT *,(IGDS(I),I=1,18) -C PRINT *,' ' -C -C COMPUTE LENGTH OF GDS IN OCTETS (OCTETS 1-3) -C LENGTH = 32 FOR LAT/LON, GNOMIC, GAUSIAN LAT/LON, -C POLAR STEREOGRAPHIC, SPHERICAL HARMONICS -C LENGTH = 42 FOR MERCATOR, LAMBERT, TANGENT CONE -C LENGTH = 178 FOR MERCATOR, LAMBERT, TANGENT CONE -C - IF (IGDS(3) .EQ. 0 .OR. IGDS(3) .EQ. 2 .OR. - & IGDS(3) .EQ. 4 .OR. IGDS(3) .EQ. 5 .OR. - & IGDS(3) .EQ. 50 .OR. IGDS(3) .EQ. 201.OR. - & IGDS(3) .EQ. 202.OR. IGDS(3) .EQ. 203.OR. - & IGDS(3) .EQ. 204) THEN - LENGDS = 32 -C -C CORRECTION FOR GRIDS 37-44 -C - IF (IGDS(3).EQ.0.AND.IGDS(1).EQ.0.AND.IGDS(2).NE. - & 255) THEN - LENGDS = IGDS(5) * 2 + 32 - ENDIF - ELSE IF (IGDS(3) .EQ. 1 .OR. IGDS(3) .EQ. 3 .OR. - & IGDS(3) .EQ. 13) THEN - LENGDS = 42 - ELSE -C PRINT *,' W3FI74 ERROR, GRID REPRESENTATION TYPE NOT VALID' - IGERR = 1 - RETURN - ENDIF -C -C PUT LENGTH OF GDS SECTION IN BYTES 1,2,3 -C - GDS(1) = CHAR(MOD(LENGDS/65536,256)) - GDS(2) = CHAR(MOD(LENGDS/ 256,256)) - GDS(3) = CHAR(MOD(LENGDS ,256)) -C -C OCTET 4 = NV, NUMBER OF VERTICAL COORDINATE PARAMETERS -C OCTET 5 = PV, PL OR 255 -C OCTET 6 = DATA REPRESENTATION TYPE (TABLE 6) -C - GDS(4) = CHAR(IGDS(1)) - GDS(5) = CHAR(IGDS(2)) - GDS(6) = CHAR(IGDS(3)) -C -C FILL OCTET THE REST OF THE GDS BASED ON DATA REPRESENTATION -C TYPE (TABLE 6) -C -C$$ -C PROCESS LAT/LON GRID TYPES OR GAUSSIAN GRID OR ARAKAWA -C STAGGERED, SEMI-STAGGERED, OR FILLED E-GRIDS -C - IF (IGDS(3).EQ.0.OR.IGDS(3).EQ.4.OR. - & IGDS(3).EQ.201.OR.IGDS(3).EQ.202.OR. - & IGDS(3).EQ.203.OR.IGDS(3).EQ.204) THEN - GDS( 7) = CHAR(MOD(IGDS(4)/256,256)) - GDS( 8) = CHAR(MOD(IGDS(4) ,256)) - GDS( 9) = CHAR(MOD(IGDS(5)/256,256)) - GDS(10) = CHAR(MOD(IGDS(5) ,256)) - LATO = IGDS(6) - IF (LATO .LT. 0) THEN - LATO = -LATO - LATO = IOR(LATO,8388608) - ENDIF - GDS(11) = CHAR(MOD(LATO/65536,256)) - GDS(12) = CHAR(MOD(LATO/ 256,256)) - GDS(13) = CHAR(MOD(LATO ,256)) - LONO = IGDS(7) - IF (LONO .LT. 0) THEN - LONO = -LONO - LONO = IOR(LONO,8388608) - ENDIF - GDS(14) = CHAR(MOD(LONO/65536,256)) - GDS(15) = CHAR(MOD(LONO/ 256,256)) - GDS(16) = CHAR(MOD(LONO ,256)) - LATEXT = IGDS(9) - IF (LATEXT .LT. 0) THEN - LATEXT = -LATEXT - LATEXT = IOR(LATEXT,8388608) - ENDIF - GDS(18) = CHAR(MOD(LATEXT/65536,256)) - GDS(19) = CHAR(MOD(LATEXT/ 256,256)) - GDS(20) = CHAR(MOD(LATEXT ,256)) - LONEXT = IGDS(10) - IF (LONEXT .LT. 0) THEN - LONEXT = -LONEXT - LONEXT = IOR(LONEXT,8388608) - ENDIF - GDS(21) = CHAR(MOD(LONEXT/65536,256)) - GDS(22) = CHAR(MOD(LONEXT/ 256,256)) - GDS(23) = CHAR(MOD(LONEXT ,256)) - IRES = IAND(IGDS(8),128) - IF (IGDS(3).EQ.201.OR.IGDS(3).EQ.202.OR. - & IGDS(3).EQ.203.OR.IGDS(3).EQ.204) THEN - GDS(24) = CHAR(MOD(IGDS(11)/256,256)) - GDS(25) = CHAR(MOD(IGDS(11) ,256)) - ELSE IF (IRES.EQ.0) THEN - GDS(24) = CHAR(255) - GDS(25) = CHAR(255) - ELSE - GDS(24) = CHAR(MOD(IGDS(12)/256,256)) - GDS(25) = CHAR(MOD(IGDS(12) ,256)) - END IF - IF (IGDS(3).EQ.4) THEN - GDS(26) = CHAR(MOD(IGDS(11)/256,256)) - GDS(27) = CHAR(MOD(IGDS(11) ,256)) - ELSE IF (IGDS(3).EQ.201.OR.IGDS(3).EQ.202.OR. - & IGDS(3).EQ.203.OR.IGDS(3).EQ.204) THEN - GDS(26) = CHAR(MOD(IGDS(12)/256,256)) - GDS(27) = CHAR(MOD(IGDS(12) ,256)) - ELSE IF (IRES.EQ.0) THEN - GDS(26) = CHAR(255) - GDS(27) = CHAR(255) - ELSE - GDS(26) = CHAR(MOD(IGDS(11)/256,256)) - GDS(27) = CHAR(MOD(IGDS(11) ,256)) - END IF - GDS(28) = CHAR(IGDS(13)) - GDS(29) = CHAR(0) - GDS(30) = CHAR(0) - GDS(31) = CHAR(0) - GDS(32) = CHAR(0) - IF (LENGDS.GT.32) THEN - ISUM = 0 - I = 19 - DO 10 J = 33,LENGDS,2 - ISUM = ISUM + IGDS(I) - GDS(J) = CHAR(MOD(IGDS(I)/256,256)) - GDS(J+1) = CHAR(MOD(IGDS(I) ,256)) - I = I + 1 - 10 CONTINUE - END IF -C -C$$ PROCESS MERCATOR GRID TYPES -C - ELSE IF (IGDS(3) .EQ. 1) THEN - GDS( 7) = CHAR(MOD(IGDS(4)/256,256)) - GDS( 8) = CHAR(MOD(IGDS(4) ,256)) - GDS( 9) = CHAR(MOD(IGDS(5)/256,256)) - GDS(10) = CHAR(MOD(IGDS(5) ,256)) - LATO = IGDS(6) - IF (LATO .LT. 0) THEN - LATO = -LATO - LATO = IOR(LATO,8388608) - ENDIF - GDS(11) = CHAR(MOD(LATO/65536,256)) - GDS(12) = CHAR(MOD(LATO/ 256,256)) - GDS(13) = CHAR(MOD(LATO ,256)) - LONO = IGDS(7) - IF (LONO .LT. 0) THEN - LONO = -LONO - LONO = IOR(LONO,8388608) - ENDIF - GDS(14) = CHAR(MOD(LONO/65536,256)) - GDS(15) = CHAR(MOD(LONO/ 256,256)) - GDS(16) = CHAR(MOD(LONO ,256)) - LATEXT = IGDS(9) - IF (LATEXT .LT. 0) THEN - LATEXT = -LATEXT - LATEXT = IOR(LATEXT,8388608) - ENDIF - GDS(18) = CHAR(MOD(LATEXT/65536,256)) - GDS(19) = CHAR(MOD(LATEXT/ 256,256)) - GDS(20) = CHAR(MOD(LATEXT ,256)) - LONEXT = IGDS(10) - IF (LONEXT .LT. 0) THEN - LONEXT = -LONEXT - LONEXT = IOR(LONEXT,8388608) - ENDIF - GDS(21) = CHAR(MOD(LONEXT/65536,256)) - GDS(22) = CHAR(MOD(LONEXT/ 256,256)) - GDS(23) = CHAR(MOD(LONEXT ,256)) - GDS(24) = CHAR(MOD(IGDS(13)/65536,256)) - GDS(25) = CHAR(MOD(IGDS(13)/ 256,256)) - GDS(26) = CHAR(MOD(IGDS(13) ,256)) - GDS(27) = CHAR(0) - GDS(28) = CHAR(IGDS(14)) - GDS(29) = CHAR(MOD(IGDS(12)/65536,256)) - GDS(30) = CHAR(MOD(IGDS(12)/ 256,256)) - GDS(31) = CHAR(MOD(IGDS(12) ,256)) - GDS(32) = CHAR(MOD(IGDS(11)/65536,256)) - GDS(33) = CHAR(MOD(IGDS(11)/ 256,256)) - GDS(34) = CHAR(MOD(IGDS(11) ,256)) - GDS(35) = CHAR(0) - GDS(36) = CHAR(0) - GDS(37) = CHAR(0) - GDS(38) = CHAR(0) - GDS(39) = CHAR(0) - GDS(40) = CHAR(0) - GDS(41) = CHAR(0) - GDS(42) = CHAR(0) -C$$ PROCESS LAMBERT CONFORMAL GRID TYPES - ELSE IF (IGDS(3) .EQ. 3) THEN - GDS( 7) = CHAR(MOD(IGDS(4)/256,256)) - GDS( 8) = CHAR(MOD(IGDS(4) ,256)) - GDS( 9) = CHAR(MOD(IGDS(5)/256,256)) - GDS(10) = CHAR(MOD(IGDS(5) ,256)) - LATO = IGDS(6) - IF (LATO .LT. 0) THEN - LATO = -LATO - LATO = IOR(LATO,8388608) - ENDIF - GDS(11) = CHAR(MOD(LATO/65536,256)) - GDS(12) = CHAR(MOD(LATO/ 256,256)) - GDS(13) = CHAR(MOD(LATO ,256)) - LONO = IGDS(7) - IF (LONO .LT. 0) THEN - LONO = -LONO - LONO = IOR(LONO,8388608) - ENDIF - GDS(14) = CHAR(MOD(LONO/65536,256)) - GDS(15) = CHAR(MOD(LONO/ 256,256)) - GDS(16) = CHAR(MOD(LONO ,256)) - LONM = IGDS(9) - IF (LONM .LT. 0) THEN - LONM = -LONM - LONM = IOR(LONM,8388608) - ENDIF - GDS(18) = CHAR(MOD(LONM/65536,256)) - GDS(19) = CHAR(MOD(LONM/ 256,256)) - GDS(20) = CHAR(MOD(LONM ,256)) - GDS(21) = CHAR(MOD(IGDS(10)/65536,256)) - GDS(22) = CHAR(MOD(IGDS(10)/ 256,256)) - GDS(23) = CHAR(MOD(IGDS(10) ,256)) - GDS(24) = CHAR(MOD(IGDS(11)/65536,256)) - GDS(25) = CHAR(MOD(IGDS(11)/ 256,256)) - GDS(26) = CHAR(MOD(IGDS(11) ,256)) - GDS(27) = CHAR(IGDS(12)) - GDS(28) = CHAR(IGDS(13)) - GDS(29) = CHAR(MOD(IGDS(15)/65536,256)) - GDS(30) = CHAR(MOD(IGDS(15)/ 256,256)) - GDS(31) = CHAR(MOD(IGDS(15) ,256)) - GDS(32) = CHAR(MOD(IGDS(16)/65536,256)) - GDS(33) = CHAR(MOD(IGDS(16)/ 256,256)) - GDS(34) = CHAR(MOD(IGDS(16) ,256)) - GDS(35) = CHAR(MOD(IGDS(17)/65536,256)) - GDS(36) = CHAR(MOD(IGDS(17)/ 256,256)) - GDS(37) = CHAR(MOD(IGDS(17) ,256)) - GDS(38) = CHAR(MOD(IGDS(18)/65536,256)) - GDS(39) = CHAR(MOD(IGDS(18)/ 256,256)) - GDS(40) = CHAR(MOD(IGDS(18) ,256)) - GDS(41) = CHAR(0) - GDS(42) = CHAR(0) -C$$ PROCESS POLAR STEREOGRAPHIC GRID TYPES - ELSE IF (IGDS(3) .EQ. 5) THEN - GDS( 7) = CHAR(MOD(IGDS(4)/256,256)) - GDS( 8) = CHAR(MOD(IGDS(4) ,256)) - GDS( 9) = CHAR(MOD(IGDS(5)/256,256)) - GDS(10) = CHAR(MOD(IGDS(5) ,256)) - LATO = IGDS(6) - IF (LATO .LT. 0) THEN - LATO = -LATO - LATO = IOR(LATO,8388608) - ENDIF - GDS(11) = CHAR(MOD(LATO/65536,256)) - GDS(12) = CHAR(MOD(LATO/ 256,256)) - GDS(13) = CHAR(MOD(LATO ,256)) - LONO = IGDS(7) - IF (LONO .LT. 0) THEN - LONO = -LONO - LONO = IOR(LONO,8388608) - ENDIF - GDS(14) = CHAR(MOD(LONO/65536,256)) - GDS(15) = CHAR(MOD(LONO/ 256,256)) - GDS(16) = CHAR(MOD(LONO ,256)) - LONM = IGDS(9) - IF (LONM .LT. 0) THEN - LONM = -LONM - LONM = IOR(LONM,8388608) - ENDIF - GDS(18) = CHAR(MOD(LONM/65536,256)) - GDS(19) = CHAR(MOD(LONM/ 256,256)) - GDS(20) = CHAR(MOD(LONM ,256)) - GDS(21) = CHAR(MOD(IGDS(10)/65536,256)) - GDS(22) = CHAR(MOD(IGDS(10)/ 256,256)) - GDS(23) = CHAR(MOD(IGDS(10) ,256)) - GDS(24) = CHAR(MOD(IGDS(11)/65536,256)) - GDS(25) = CHAR(MOD(IGDS(11)/ 256,256)) - GDS(26) = CHAR(MOD(IGDS(11) ,256)) - GDS(27) = CHAR(IGDS(12)) - GDS(28) = CHAR(IGDS(13)) - GDS(29) = CHAR(0) - GDS(30) = CHAR(0) - GDS(31) = CHAR(0) - GDS(32) = CHAR(0) - ENDIF -C PRINT 10,(GDS(IG),IG=1,32) -C10 FORMAT (' GDS= ',32(1X,Z2.2)) -C -C COMPUTE NUMBER OF POINTS IN GRID BY MULTIPLYING -C IGDS(4) AND IGDS(5) ... NEEDED FOR PACKER -C - IF (IGDS(3).EQ.0.AND.IGDS(1).EQ.0.AND.IGDS(2).NE. - & 255) THEN - NPTS = ISUM - ELSE - NPTS = IGDS(4) * IGDS(5) - ENDIF -C -C 'IOR' ICOMP-BIT 5 RESOLUTION & COMPONENT FLAG FOR WINDS -C WITH IGDS(8) INFO (REST OF RESOLUTION & COMPONENT FLAG DATA) -C - ITEMP = ISHFT(ICOMP,3) - GDS(17) = CHAR(IOR(IGDS(8),ITEMP)) -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi75.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi75.f deleted file mode 100755 index 3f2234f9a7..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi75.f +++ /dev/null @@ -1,1619 +0,0 @@ - SUBROUTINE W3FI75 (IBITL,ITYPE,ITOSS,FLD,IFLD,IBMAP,IBDSFL, - & NPTS,BDS11,IPFLD,PFLD,LEN,LENBDS,IBERR,PDS,IGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI75 GRIB PACK DATA AND FORM BDS OCTETS(1-11) -C PRGMMR: FARLEY ORG: NMC421 DATE:94-11-22 -C -C ABSTRACT: THIS ROUTINE PACKS A GRIB FIELD AND FORMS OCTETS(1-11) -C OF THE BINARY DATA SECTION (BDS). -C -C PROGRAM HISTORY LOG: -C 92-07-10 M. FARLEY ORIGINAL AUTHOR -C 92-10-01 R.E.JONES CORRECTION FOR FIELD OF CONSTANT DATA -C 92-10-16 R.E.JONES GET RID OF ARRAYS FP AND INT -C 93-08-06 CAVANAUGH ADDED ROUTINES FI7501, FI7502, FI7503 -C TO ALLOW SECOND ORDER PACKING IN PDS. -C 93-07-21 STACKPOLE ASSORTED REPAIRS TO GET 2ND DIFF PACK IN -C 93-10-28 CAVANAUGH COMMENTED OUT NONOPERATIONAL PRINTS AND -C WRITE STATEMENTS -C 93-12-15 CAVANAUGH CORRECTED LOCATION OF START OF FIRST ORDER -C VALUES AND START OF SECOND ORDER VALUES TO -C REFLECT A BYTE LOCATION IN THE BDS INSTEAD -C OF AN OFFSET IN SUBROUTINE FI7501. -C 94-01-27 CAVANAUGH ADDED IGDS AS INPUT ARGUMENT TO THIS ROUTINE -C AND ADDED PDS AND IGDS ARRAYS TO THE CALL TO -C W3FI82 TO PROVIDE INFORMATION NEEDED FOR -C BOUSTROPHEDONIC PROCESSING. -C 94-05-25 CAVANAUGH SUBROUTINE FI7503 HAS BEEN ADDED TO PROVIDE -C FOR ROW BY ROW OR COLUMN BY COLUMN SECOND -C ORDER PACKING. THIS FEATURE CAN BE ACTIVATED -C BY SETTING IBDSFL(7) TO ZERO. -C 94-07-08 CAVANAUGH COMMENTED OUT PRINT STATEMENTS USED FOR DEBUG -C 94-11-22 FARLEY ENLARGED WORK ARRAYS TO HANDLE .5DEGREE GRIDS -C 95-06-01 R.E.JONES CORRECTION FOR NUMBER OF UNUSED BITS AT END -C OF SECTION 4, IN BDS BYTE 4, BITS 5-8. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 2001-06-06 GILBERT CHanged gbyte/sbyte calls to refer to -C Wesley Ebisuzaki's endian independent -C versions gbytec/sbytec. -C Use f90 standard routine bit_size to get -C number of bits in an integer instead of w3fi01. -C -C USAGE: CALL W3FI75 (IBITL,ITYPE,ITOSS,FLD,IFLD,IBMAP,IBDSFL, -C & NPTS,BDS11,IPFLD,PFLD,LEN,LENBDS,IBERR,PDS,IGDS) -C INPUT ARGUMENT LIST: -C IBITL - 0, COMPUTER COMPUTES PACKING LENGTH FROM POWER -C OF 2 THAT BEST FITS THE DATA. -C 8, 12, ETC. COMPUTER RESCALES DATA TO FIT INTO -C SET NUMBER OF BITS. -C ITYPE - 0 = IF INPUT DATA IS FLOATING POINT (FLD) -C 1 = IF INPUT DATA IS INTEGER (IFLD) -C ITOSS - 0 = NO BIT MAP IS INCLUDED (DON'T TOSS DATA) -C 1 = TOSS NULL DATA ACCORDING TO IBMAP -C FLD - REAL ARRAY OF DATA TO BE PACKED IF ITYPE=0 -C IFLD - INTEGER ARRAY TO BE PACKED IF ITYPE=1 -C IBMAP - BIT MAP SUPPLIED FROM USER -C IBDSFL - INTEGER ARRAY CONTAINING TABLE 11 FLAG INFO -C BDS OCTET 4: -C (1) 0 = GRID POINT DATA -C 1 = SPHERICAL HARMONIC COEFFICIENTS -C (2) 0 = SIMPLE PACKING -C 1 = SECOND ORDER PACKING -C (3) 0 = ORIGINAL DATA WERE FLOATING POINT VALUES -C 1 = ORIGINAL DATA WERE INTEGER VALUES -C (4) 0 = NO ADDITIONAL FLAGS AT OCTET 14 -C 1 = OCTET 14 CONTAINS FLAG BITS 5-12 -C (5) 0 = RESERVED - ALWAYS SET TO 0 -C (6) 0 = SINGLE DATUM AT EACH GRID POINT -C 1 = MATRIX OF VALUES AT EACH GRID POINT -C (7) 0 = NO SECONDARY BIT MAPS -C 1 = SECONDARY BIT MAPS PRESENT -C (8) 0 = SECOND ORDER VALUES HAVE CONSTANT WIDTH -C 1 = SECOND ORDER VALUES HAVE DIFFERENT WIDTHS -C NPTS - NUMBER OF GRIDPOINTS IN ARRAY TO BE PACKED -C IGDS - ARRAY OF GDS INFORMATION -C -C OUTPUT ARGUMENT LIST: -C BDS11 - FIRST 11 OCTETS OF BDS -C PFLD - PACKED GRIB FIELD -C LEN - LENGTH OF PFLD -C LENBDS - LENGTH OF BDS -C IBERR - 1, ERROR CONVERTING IEEE F.P. NUMBER TO IBM370 F.P. -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ -C - REAL FLD(*) -C REAL FWORK(260000) -C -C FWORK CAN USE DYNAMIC ALLOCATION OF MEMORY ON CRAY -C - REAL FWORK(NPTS) - REAL RMIN,REFNCE -C - character(len=1) IPFLD(*) - INTEGER IBDSFL(*) - INTEGER IBMAP(*) - INTEGER IFLD(*),IGDS(*) -C INTEGER IWORK(260000) -C -C IWORK CAN USE DYNAMIC ALLOCATION OF MEMORY ON CRAY -C - INTEGER IWORK(NPTS) -C - LOGICAL CONST -C - CHARACTER * 1 BDS11(11),PDS(*) - CHARACTER * 1 PFLD(*) -C -C 1.0 PACK THE FIELD. -C -C 1.1 TOSS DATA IF BITMAP BEING USED, -C MOVING 'DATA' TO WORK AREA... -C - CONST = .FALSE. - IBERR = 0 - IW = 0 -C - IF (ITOSS .EQ. 1) THEN - IF (ITYPE .EQ. 0) THEN - DO 110 IT=1,NPTS - IF (IBMAP(IT) .EQ. 1) THEN - IW = IW + 1 - FWORK(IW) = FLD(IT) - ENDIF - 110 CONTINUE - NPTS = IW - ELSE IF (ITYPE .EQ. 1) THEN - DO 111 IT=1,NPTS - IF (IBMAP(IT) .EQ. 1) THEN - IW = IW + 1 - IWORK(IW) = IFLD(IT) - ENDIF - 111 CONTINUE - NPTS = IW - ENDIF -C -C ELSE, JUST MOVE DATA TO WORK ARRAY -C - ELSE IF (ITOSS .EQ. 0) THEN - IF (ITYPE .EQ. 0) THEN - DO 112 IT=1,NPTS - FWORK(IT) = FLD(IT) - 112 CONTINUE - ELSE IF (ITYPE .EQ. 1) THEN - DO 113 IT=1,NPTS - IWORK(IT) = IFLD(IT) - 113 CONTINUE - ENDIF - ENDIF -C -C 1.2 CONVERT DATA IF NEEDED PRIOR TO PACKING. -C (INTEGER TO F.P. OR F.P. TO INTEGER) -C ITYPE = 0...FLOATING POINT DATA -C IBITL = 0...PACK IN LEAST # BITS...CONVERT TO INTEGER -C ITYPE = 1...INTEGER DATA -C IBITL > 0...PACK IN FIXED # BITS...CONVERT TO FLOATING POINT -C - IF (ITYPE .EQ. 0 .AND. IBITL .EQ. 0) THEN - DO 120 IF=1,NPTS - IWORK(IF) = NINT(FWORK(IF)) - 120 CONTINUE - ELSE IF (ITYPE .EQ. 1 .AND. IBITL .NE. 0) THEN - DO 123 IF=1,NPTS - FWORK(IF) = FLOAT(IWORK(IF)) - 123 CONTINUE - ENDIF -C -C 1.3 PACK THE DATA. -C - IF (IBDSFL(2).NE.0) THEN -C SECOND ORDER PACKING -C -C PRINT*,' DOING SECOND ORDER PACKING...' - IF (IBITL.EQ.0) THEN -C -C PRINT*,' AND VARIABLE BIT PACKING' -C -C WORKING WITH INTEGER VALUES -C SINCE DOING VARIABLE BIT PACKING -C - MAX = IWORK(1) - MIN = IWORK(1) - DO 300 I = 2, NPTS - IF (IWORK(I).LT.MIN) THEN - MIN = IWORK(I) - ELSE IF (IWORK(I).GT.MAX) THEN - MAX = IWORK(I) - END IF - 300 CONTINUE -C EXTRACT MINIMA - DO 400 I = 1, NPTS -C IF (IWORK(I).LT.0) THEN -C PRINT *,'MINIMA 400',I,IWORK(I),NPTS -C END IF - IWORK(I) = IWORK(I) - MIN - 400 CONTINUE - REFNCE = MIN - IDIFF = MAX - MIN -C PRINT *,'REFERENCE VALUE',REFNCE -C -C WRITE (6,FMT='('' MINIMA REMOVED = '',/, -C & 10(3X,10I10,/))') (IWORK(I),I=1,6) -C WRITE (6,FMT='('' END OF ARRAY = '',/, -C & 10(3X,10I10,/))') (IWORK(I),I=NPTS-5,NPTS) -C -C FIND BIT WIDTH OF IDIFF -C - CALL FI7505 (IDIFF,KWIDE) -C PRINT*,' BIT WIDTH FOR ORIGINAL DATA', KWIDE - ISCAL2 = 0 -C -C MULTIPLICATIVE SCALE FACTOR SET TO 1 -C IN ANTICIPATION OF POSSIBLE USE IN GLAHN 2DN DIFF -C - SCAL2 = 1. -C - ELSE -C -C PRINT*,' AND FIXED BIT PACKING, IBITL = ', IBITL -C FIXED BIT PACKING -C - LENGTH OF FIELD IN IBITL -C - MUST BE REAL DATA -C FLOATING POINT INPUT -C - RMAX = FWORK(1) - RMIN = FWORK(1) - DO 100 I = 2, NPTS - IF (FWORK(I).LT.RMIN) THEN - RMIN = FWORK(I) - ELSE IF (FWORK(I).GT.RMAX) THEN - RMAX = FWORK(I) - END IF - 100 CONTINUE - REFNCE = RMIN -C PRINT *,'100 REFERENCE',REFNCE -C EXTRACT MINIMA - DO 200 I = 1, NPTS - FWORK(I) = FWORK(I) - RMIN - 200 CONTINUE -C PRINT *,'REFERENCE VALUE',REFNCE -C WRITE (6,FMT='('' MINIMA REMOVED = '',/, -C & 10(3X,10F8.2,/))') (FWORK(I),I=1,6) -C WRITE (6,FMT='('' END OF ARRAY = '',/, -C & 10(3X,10F8.2,/))') (FWORK(I),I=NPTS-5,NPTS) -C FIND LARGEST DELTA - IDELT = NINT(RMAX - RMIN) -C DO BINARY SCALING -C FIND OUT WHAT BINARY SCALE FACTOR -C PERMITS CONTAINMENT OF -C LARGEST DELTA - CALL FI7505 (IDELT,IWIDE) -C -C BINARY SCALING -C - ISCAL2 = IWIDE - IBITL -C PRINT *,'SCALING NEEDED TO FIT =',ISCAL2 -C PRINT*,' RANGE OF = ',IDELT -C -C EXPAND DATA WITH BINARY SCALING -C CONVERT TO INTEGER - SCAL2 = 2.0**ISCAL2 - SCAL2 = 1./ SCAL2 - DO 600 I = 1, NPTS - IWORK(I) = NINT(FWORK(I) * SCAL2) - 600 CONTINUE - KWIDE = IBITL - END IF -C -C ***************************************************************** -C -C FOLLOWING IS FOR GLAHN SECOND DIFFERENCING -C NOT STANDARD GRIB -C -C TEST FOR SECOND DIFFERENCE PACKING -C BASED OF SIZE OF PDS - SIZE IN FIRST 3 BYTES -C - CALL GBYTEC(PDS,IPDSIZ,0,24) - IF (IPDSIZ.EQ.50) THEN -C PRINT*,' DO SECOND DIFFERENCE PACKING ' -C -C GLAHN PACKING TO 2ND DIFFS -C -C WRITE (6,FMT='('' CALL TO W3FI82 WITH = '',/, -C & 10(3X,10I6,/))') (IWORK(I),I=1,NPTS) -C - CALL W3FI82 (IWORK,FVAL1,FDIFF1,NPTS,PDS,IGDS) -C -C PRINT *,'GLAHN',FVAL1,FDIFF1 -C WRITE (6,FMT='('' OUT FROM W3FI82 WITH = '',/, -C & 10(3X,10I6,/))') (IWORK(I),I=1,NPTS) -C -C MUST NOW RE-REMOVE THE MINIMUM VALUE -C OF THE SECOND DIFFERENCES TO ASSURE -C ALL POSITIVE NUMBERS FOR SECOND ORDER GRIB PACKING -C -C ORIGINAL REFERENCE VALUE ADDED TO FIRST POINT -C VALUE FROM THE 2ND DIFF PACKER TO BE ADDED -C BACK IN WHEN THE 2ND DIFF VALUES ARE -C RECONSTRUCTED BACK TO THE BASIC VALUES -C -C ALSO, THE REFERENCE VALUE IS -C POWER-OF-TWO SCALED TO MATCH -C FVAL1. ALL OF THIS SCALING -C WILL BE REMOVED AFTER THE -C GLAHN SECOND DIFFERENCING IS UNDONE. -C THE SCALING FACTOR NEEDED TO DO THAT -C IS SAVED IN THE PDS AS A SIGNED POSITIVE -C TWO BYTE INTEGER -C -C THE SCALING FOR THE 2ND DIF PACKED -C VALUES IS PROPERLY SET TO ZERO -C - FVAL1 = FVAL1 + REFNCE*SCAL2 -C FIRST TEST TO SEE IF -C ON 32 OR 64 BIT COMPUTER -C CALL W3FI01(LW) - IF (bit_size(LW).EQ.32) THEN - CALL W3FI76 (FVAL1,IEXP,IMANT,32) - ELSE - CALL W3FI76 (FVAL1,IEXP,IMANT,64) - END IF - CALL SBYTEC(PDS,IEXP,320,8) - CALL SBYTEC(PDS,IMANT,328,24) -C - IF (bit_size(LW).EQ.32) THEN - CALL W3FI76 (FDIFF1,IEXP,IMANT,32) - ELSE - CALL W3FI76 (FDIFF1,IEXP,IMANT,64) - END IF - CALL SBYTEC(PDS,IEXP,352,8) - CALL SBYTEC(PDS,IMANT,360,24) -C -C TURN ISCAL2 INTO SIGNED POSITIVE INTEGER -C AND STORE IN TWO BYTES -C - IF(ISCAL2.GE.0) THEN - CALL SBYTEC(PDS,ISCAL2,384,16) - ELSE - CALL SBYTEC(PDS,1,384,1) - ISCAL2 = - ISCAL2 - CALL SBYTEC( PDS,ISCAL2,385,15) - ENDIF -C - MAX = IWORK(1) - MIN = IWORK(1) - DO 700 I = 2, NPTS - IF (IWORK(I).LT.MIN) THEN - MIN = IWORK(I) - ELSE IF (IWORK(I).GT.MAX) THEN - MAX = IWORK(I) - END IF - 700 CONTINUE -C EXTRACT MINIMA - DO 710 I = 1, NPTS - IWORK(I) = IWORK(I) - MIN - 710 CONTINUE - REFNCE = MIN -C PRINT *,'710 REFERENCE',REFNCE - ISCAL2 = 0 -C -C AND RESET VALUE OF KWIDE - THE BIT WIDTH -C FOR THE RANGE OF THE VALUES -C - IDIFF = MAX - MIN - CALL FI7505 (IDIFF,KWIDE) -C -C PRINT*,'BIT WIDTH (KWIDE) OF 2ND DIFFS', KWIDE -C -C **************************** END OF GLAHN PACKING ************ - ELSE IF (IBDSFL(2).EQ.1.AND.IBDSFL(7).EQ.0) THEN -C HAVE SECOND ORDER PACKING WITH NO SECOND ORDER -C BIT MAP. ERGO ROW BY ROW - COL BY COL - CALL FI7503 (IWORK,IPFLD,NPTS,IBDSFL,BDS11, - * LEN,LENBDS,PDS,REFNCE,ISCAL2,KWIDE,IGDS) - RETURN - END IF -C WRITE (6,FMT='('' CALL TO FI7501 WITH = '',/, -C & 10(3X,10I6,/))') (IWORK(I),I=1,NPTS) -C WRITE (6,FMT='('' END OF ARRAY = '',/, -C & 10(3X,10I6,/))') (IWORK(I),I=NPTS-5,NPTS) -C PRINT*,' REFNCE,ISCAL2, KWIDE AT CALL TO FI7501', -C & REFNCE, ISCAL2,KWIDE -C -C SECOND ORDER PACKING -C - CALL FI7501 (IWORK,IPFLD,NPTS,IBDSFL,BDS11, - * LEN,LENBDS,PDS,REFNCE,ISCAL2,KWIDE) -C -C BDS COMPLETELY ASSEMBLED IN FI7501 FOR SECOND ORDER -C PACKING. -C - ELSE -C SIMPLE PACKING -C -C PRINT*,' SIMPLE FIRST ORDER PACKING...' - IF (IBITL.EQ.0) THEN -C PRINT*,' WITH VARIABLE BIT LENGTH' -C -C WITH VARIABLE BIT LENGTH, ADJUSTED -C TO ACCOMMODATE LARGEST VALUE -C BINARY SCALING ALWAYS = 0 -C - CALL W3FI58(IWORK,NPTS,IWORK,PFLD,NBITS,LEN,KMIN) - RMIN = KMIN - REFNCE = RMIN - ISCALE = 0 -C PRINT*,' BIT LENGTH CAME OUT AT ...',NBITS -C -C SET CONST .TRUE. IF ALL VALUES ARE THE SAME -C - IF (LEN.EQ.0.AND.NBITS.EQ.0) CONST = .TRUE. -C - ELSE -C PRINT*,' FIXED BIT LENGTH, IBITL = ', IBITL -C -C FIXED BIT LENGTH PACKING (VARIABLE PRECISION) -C VALUES SCALED BY POWER OF 2 (ISCALE) TO -C FIT LARGEST VALUE INTO GIVEN BIT LENGTH (IBITL) -C - CALL W3FI59(FWORK,NPTS,IBITL,IWORK,PFLD,ISCALE,LEN,RMIN) - REFNCE = RMIN -C PRINT *,' SCALING NEEDED TO FIT IS ...', ISCALE - NBITS = IBITL -C -C SET CONST .TRUE. IF ALL VALUES ARE THE SAME -C - IF (LEN.EQ.0) THEN - CONST = .TRUE. - NBITS = 0 - END IF - END IF -C -C$ COMPUTE LENGTH OF BDS IN OCTETS -C - INUM = NPTS * NBITS + 88 -C PRINT *,'NUMBER OF BITS BEFORE FILL ADDED',INUM -C -C NUMBER OF FILL BITS - NFILL = 0 - NLEFT = MOD(INUM,16) - IF (NLEFT.NE.0) THEN - INUM = INUM + 16 - NLEFT - NFILL = 16 - NLEFT - END IF -C PRINT *,'NUMBER OF BITS AFTER FILL ADDED',INUM -C LENGTH OF BDS IN BYTES - LENBDS = INUM / 8 -C -C 2.0 FORM THE BINARY DATA SECTION (BDS). -C -C CONCANTENATE ALL FIELDS FOR BDS -C -C BYTES 1-3 - CALL SBYTEC (BDS11,LENBDS,0,24) -C -C BYTE 4 -C FLAGS - CALL SBYTEC (BDS11,IBDSFL(1),24,1) - CALL SBYTEC (BDS11,IBDSFL(2),25,1) - CALL SBYTEC (BDS11,IBDSFL(3),26,1) - CALL SBYTEC (BDS11,IBDSFL(4),27,1) -C NR OF FILL BITS - CALL SBYTEC (BDS11,NFILL,28,4) -C -C$ FILL OCTETS 5-6 WITH THE SCALE FACTOR. -C -C BYTE 5-6 - IF (ISCALE.LT.0) THEN - CALL SBYTEC (BDS11,1,32,1) - ISCALE = - ISCALE - CALL SBYTEC (BDS11,ISCALE,33,15) - ELSE - CALL SBYTEC (BDS11,ISCALE,32,16) - END IF -C -C$ FILL OCTET 7-10 WITH THE REFERENCE VALUE -C CONVERT THE FLOATING POINT OF YOUR MACHINE TO IBM370 32 BIT -C FLOATING POINT NUMBER -C -C BYTE 7-10 -C REFERENCE VALUE -C FIRST TEST TO SEE IF -C ON 32 OR 64 BIT COMPUTER -C CALL W3FI01(LW) - IF (bit_size(LW).EQ.32) THEN - CALL W3FI76 (REFNCE,IEXP,IMANT,32) - ELSE - CALL W3FI76 (REFNCE,IEXP,IMANT,64) - END IF - CALL SBYTEC (BDS11,IEXP,48,8) - CALL SBYTEC (BDS11,IMANT,56,24) -C -C -C$ FILL OCTET 11 WITH THE NUMBER OF BITS. -C -C BYTE 11 - CALL SBYTEC (BDS11,NBITS,80,8) - END IF -C - RETURN - END - SUBROUTINE FI7501 (IWORK,IPFLD,NPTS,IBDSFL,BDS11, - * LEN,LENBDS,PDS,REFNCE,ISCAL2,KWIDE) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7501 BDS SECOND ORDER PACKING -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 93-08-06 -C -C ABSTRACT: PERFORM SECONDARY PACKING ON GRID POINT DATA, -C GENERATING ALL BDS INFORMATION. -C -C PROGRAM HISTORY LOG: -C 93-08-06 CAVANAUGH -C 93-12-15 CAVANAUGH CORRECTED LOCATION OF START OF FIRST ORDER -C VALUES AND START OF SECOND ORDER VALUES TO -C REFLECT A BYTE LOCATION IN THE BDS INSTEAD -C OF AN OFFSET. -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI7501 (IWORK,IPFLD,NPTS,IBDSFL,BDS11, -C * LEN,LENBDS,PDS,REFNCE,ISCAL2,KWIDE) -C INPUT ARGUMENT LIST: -C IWORK - INTEGER SOURCE ARRAY -C NPTS - NUMBER OF POINTS IN IWORK -C IBDSFL - FLAGS -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C IPFLD - CONTAINS BDS FROM BYTE 12 ON -C BDS11 - CONTAINS FIRST 11 BYTES FOR BDS -C LEN - NUMBER OF BYTES FROM 12 ON -C LENBDS - TOTAL LENGTH OF BDS -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - CHARACTER*1 BDS11(*),PDS(*) -C - REAL REFNCE -C - INTEGER ISCAL2,KWIDE - INTEGER LENBDS - CHARACTER(len=1) IPFLD(*) - INTEGER LEN,KBDS(22) - INTEGER IWORK(*) -C OCTET NUMBER IN SECTION, FIRST ORDER PACKING -C INTEGER KBDS(12) -C FLAGS - INTEGER IBDSFL(*) -C EXTENDED FLAGS -C INTEGER KBDS(14) -C OCTET NUMBER FOR SECOND ORDER PACKING -C INTEGER KBDS(15) -C NUMBER OF FIRST ORDER VALUES -C INTEGER KBDS(17) -C NUMBER OF SECOND ORDER PACKED VALUES -C INTEGER KBDS(19) -C WIDTH OF SECOND ORDER PACKING - character(len=1) ISOWID(400000) -C SECONDARY BIT MAP - character(len=1) ISOBMP(65600) -C FIRST ORDER PACKED VALUES - character(len=1) IFOVAL(400000) -C SECOND ORDER PACKED VALUES - character(len=1) ISOVAL(800000) -C -C INTEGER KBDS(11) -C BIT WIDTH TABLE - INTEGER IBITS(31) -C - DATA IBITS/1,3,7,15,31,63,127,255,511,1023, - * 2047,4095,8191,16383,32767,65535,131072, - * 262143,524287,1048575,2097151,4194303, - * 8388607,16777215,33554431,67108863, - * 134217727,268435455,536870911, - * 1073741823,2147483647/ -C ---------------------------------- -C INITIALIZE ARRAYS - - DO I = 1, 400000 - IFOVAL(I) = char(0) - ISOWID(I) = char(0) - ENDDO -C - DO 101 I = 1, 65600 - ISOBMP(I) = char(0) - 101 CONTINUE - DO 102 I = 1, 800000 - ISOVAL(I) = char(0) - 102 CONTINUE -C INITIALIZE POINTERS -C SECONDARY BIT WIDTH POINTER - IWDPTR = 0 -C SECONDARY BIT MAP POINTER - IBMP2P = 0 -C FIRST ORDER VALUE POINTER - IFOPTR = 0 -C BYTE POINTER TO START OF 1ST ORDER VALUES - KBDS(12) = 0 -C BYTE POINTER TO START OF 2ND ORDER VALUES - KBDS(15) = 0 -C TO CONTAIN NUMBER OF FIRST ORDER VALUES - KBDS(17) = 0 -C TO CONTAIN NUMBER OF SECOND ORDER VALUES - KBDS(19) = 0 -C SECOND ORDER PACKED VALUE POINTER - ISOPTR = 0 -C ======================================================= -C -C DATA IS IN IWORK -C - KBDS(11) = KWIDE -C -C DATA PACKING -C - ITER = 0 - INEXT = 1 - ISTART = 1 -C ----------------------------------------------------------- - KOUNT = 0 -C DO 1 I = 1, NPTS, 10 -C PRINT *,I,(IWORK(K),K=I, I+9) -C 1 CONTINUE - 2000 CONTINUE - ITER = ITER + 1 -C PRINT *,'NEXT ITERATION STARTS AT',ISTART - IF (ISTART.GT.NPTS) THEN - GO TO 4000 - ELSE IF (ISTART.EQ.NPTS) THEN - KPTS = 1 - MXDIFF = 0 - GO TO 2200 - END IF -C -C LOOK FOR REPITITIONS OF A SINGLE VALUE - CALL FI7502 (IWORK,ISTART,NPTS,ISAME) - IF (ISAME.GE.15) THEN - KOUNT = KOUNT + 1 -C PRINT *,'FI7501 - FOUND IDENTICAL SET OF ',ISAME - MXDIFF = 0 - KPTS = ISAME - ELSE -C -C LOOK FOR SETS OF VALUES IN TREND SELECTED RANGE - CALL FI7513 (IWORK,ISTART,NPTS,NMAX,NMIN,INRNGE) -C PRINT *,'ISTART ',ISTART,' INRNGE',INRNGE,NMAX,NMIN - IEND = ISTART + INRNGE - 1 -C DO 2199 NM = ISTART, IEND, 10 -C PRINT *,' ',(IWORK(NM+JK),JK=0,9) -C2199 CONTINUE - MXDIFF = NMAX - NMIN - KPTS = INRNGE - END IF - 2200 CONTINUE -C PRINT *,' RANGE ',MXDIFF,' MAX',NMAX,' MIN',NMIN -C INCREMENT NUMBER OF FIRST ORDER VALUES - KBDS(17) = KBDS(17) + 1 -C ENTER FIRST ORDER VALUE - IF (MXDIFF.GT.0) THEN - DO 2220 LK = 0, KPTS-1 - IWORK(ISTART+LK) = IWORK(ISTART+LK) - NMIN - 2220 CONTINUE - CALL SBYTEC (IFOVAL,NMIN,IFOPTR,KBDS(11)) - ELSE - CALL SBYTEC (IFOVAL,IWORK(ISTART),IFOPTR,KBDS(11)) - END IF - IFOPTR = IFOPTR + KBDS(11) -C PROCESS SECOND ORDER BIT WIDTH - IF (MXDIFF.GT.0) THEN - DO 2330 KWIDE = 1, 31 - IF (MXDIFF.LE.IBITS(KWIDE)) THEN - GO TO 2331 - END IF - 2330 CONTINUE - 2331 CONTINUE - ELSE - KWIDE = 0 - END IF - CALL SBYTEC (ISOWID,KWIDE,IWDPTR,8) - IWDPTR = IWDPTR + 8 -C PRINT *,KWIDE,' IFOVAL=',NMIN,IWORK(ISTART),KPTS -C IF KWIDE NE 0, SAVE SECOND ORDER VALUE - IF (KWIDE.GT.0) THEN - CALL SBYTESC (ISOVAL,IWORK(ISTART),ISOPTR,KWIDE,0,KPTS) - ISOPTR = ISOPTR + KPTS * KWIDE - KBDS(19) = KBDS(19) + KPTS -C PRINT *,' SECOND ORDER VALUES' -C PRINT *,(IWORK(ISTART+I),I=0,KPTS-1) - END IF -C ADD TO SECOND ORDER BITMAP - CALL SBYTEC (ISOBMP,1,IBMP2P,1) - IBMP2P = IBMP2P + KPTS - ISTART = ISTART + KPTS - GO TO 2000 -C -------------------------------------------------------------- - 4000 CONTINUE -C PRINT *,'THERE WERE ',ITER,' SECOND ORDER GROUPS' -C PRINT *,'THERE WERE ',KOUNT,' STRINGS OF CONSTANTS' -C CONCANTENATE ALL FIELDS FOR BDS -C -C REMAINDER GOES INTO IPFLD - IPTR = 0 -C BYTES 12-13 -C VALUE FOR N1 -C LEAVE SPACE FOR THIS - IPTR = IPTR + 16 -C BYTE 14 -C EXTENDED FLAGS - CALL SBYTEC (IPFLD,IBDSFL(5),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(6),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(7),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(8),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(9),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(10),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(11),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(12),IPTR,1) - IPTR = IPTR + 1 -C BYTES 15-16 -C SKIP OVER VALUE FOR N2 - IPTR = IPTR + 16 -C BYTES 17-18 -C P1 - CALL SBYTEC (IPFLD,KBDS(17),IPTR,16) - IPTR = IPTR + 16 -C BYTES 19-20 -C P2 - CALL SBYTEC (IPFLD,KBDS(19),IPTR,16) - IPTR = IPTR + 16 -C BYTE 21 - RESERVED LOCATION - CALL SBYTEC (IPFLD,0,IPTR,8) - IPTR = IPTR + 8 -C BYTES 22 - ? -C WIDTHS OF SECOND ORDER PACKING - IX = (IWDPTR + 32) / 32 -C CALL SBYTESC (IPFLD,ISOWID,IPTR,32,0,IX) - ijk=IWDPTR/8 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=ISOWID(1:ijk) - IPTR = IPTR + IWDPTR -C SECONDARY BIT MAP - IJ = (IBMP2P + 32) / 32 -C CALL SBYTESC (IPFLD,ISOBMP,IPTR,32,0,IJ) - ijk=(IBMP2P/8)+1 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=ISOBMP(1:ijk) - IPTR = IPTR + IBMP2P - IF (MOD(IPTR,8).NE.0) THEN - IPTR = IPTR + 8 - MOD(IPTR,8) - END IF -C DETERMINE LOCATION FOR START -C OF FIRST ORDER PACKED VALUES - KBDS(12) = IPTR / 8 + 12 -C STORE LOCATION - CALL SBYTEC (IPFLD,KBDS(12),0,16) -C MOVE IN FIRST ORDER PACKED VALUES - IPASS = (IFOPTR + 32) / 32 -C CALL SBYTESC (IPFLD,IFOVAL,IPTR,32,0,IPASS) - ijk=(IFOPTR/8)+1 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=ifoval(1:ijk) - IPTR = IPTR + IFOPTR - IF (MOD(IPTR,8).NE.0) THEN - IPTR = IPTR + 8 - MOD(IPTR,8) - END IF -C PRINT *,'IFOPTR =',IFOPTR,' ISOPTR =',ISOPTR -C DETERMINE LOCATION FOR START -C OF SECOND ORDER VALUES - KBDS(15) = IPTR / 8 + 12 -C SAVE LOCATION OF SECOND ORDER VALUES - CALL SBYTEC (IPFLD,KBDS(15),24,16) -C MOVE IN SECOND ORDER PACKED VALUES - IX = (ISOPTR + 32) / 32 -c CALL SBYTESC (IPFLD,ISOVAL,IPTR,32,0,IX) - ijk=(ISOPTR/8)+1 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=isoval(1:ijk) - IPTR = IPTR + ISOPTR - NLEFT = MOD(IPTR+88,16) - IF (NLEFT.NE.0) THEN - NLEFT = 16 - NLEFT - IPTR = IPTR + NLEFT - END IF -C COMPUTE LENGTH OF DATA PORTION - LEN = IPTR / 8 -C COMPUTE LENGTH OF BDS - LENBDS = LEN + 11 -C ----------------------------------- -C BYTES 1-3 -C THIS FUNCTION COMPLETED BELOW -C WHEN LENGTH OF BDS IS KNOWN - CALL SBYTEC (BDS11,LENBDS,0,24) -C BYTE 4 - CALL SBYTEC (BDS11,IBDSFL(1),24,1) - CALL SBYTEC (BDS11,IBDSFL(2),25,1) - CALL SBYTEC (BDS11,IBDSFL(3),26,1) - CALL SBYTEC (BDS11,IBDSFL(4),27,1) -C ENTER NUMBER OF FILL BITS - CALL SBYTEC (BDS11,NLEFT,28,4) -C BYTE 5-6 - IF (ISCAL2.LT.0) THEN - CALL SBYTEC (BDS11,1,32,1) - ISCAL2 = - ISCAL2 - ELSE - CALL SBYTEC (BDS11,0,32,1) - END IF - CALL SBYTEC (BDS11,ISCAL2,33,15) -C -C$ FILL OCTET 7-10 WITH THE REFERENCE VALUE -C CONVERT THE FLOATING POINT OF YOUR MACHINE TO IBM370 32 BIT -C FLOATING POINT NUMBER -C REFERENCE VALUE -C FIRST TEST TO SEE IF -C ON 32 OR 64 BIT COMPUTER -C CALL W3FI01(LW) - IF (bit_size(LW).EQ.32) THEN - CALL W3FI76 (REFNCE,IEXP,IMANT,32) - ELSE - CALL W3FI76 (REFNCE,IEXP,IMANT,64) - END IF - CALL SBYTEC (BDS11,IEXP,48,8) - CALL SBYTEC (BDS11,IMANT,56,24) -C -C BYTE 11 -C - CALL SBYTEC (BDS11,KBDS(11),80,8) -C - RETURN - END - SUBROUTINE FI7502 (IWORK,ISTART,NPTS,ISAME) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7502 SECOND ORDER SAME VALUE COLLECTION -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 93-06-23 -C -C ABSTRACT: COLLECT SEQUENTIAL SAME VALUES FOR PROCESSING -C AS SECOND ORDER VALUE FOR GRIB MESSAGES. -C -C PROGRAM HISTORY LOG: -C 93-06-23 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI7502 (IWORK,ISTART,NPTS,ISAME) -C INPUT ARGUMENT LIST: -C IWORK - ARRAY CONTAINING SOURCE DATA -C ISTART - STARTING LOCATION FOR THIS TEST -C NPTS - NUMBER OF POINTS IN IWORK -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C ISAME - NUMBER OF SEQUENTIAL POINTS HAVING THE SAME VALUE -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - INTEGER IWORK(*) - INTEGER ISTART - INTEGER ISAME - INTEGER K - INTEGER NPTS -C ------------------------------------------------------------- - ISAME = 0 - DO 100 K = ISTART, NPTS - IF (IWORK(K).NE.IWORK(ISTART)) THEN - RETURN - END IF - ISAME = ISAME + 1 - 100 CONTINUE - RETURN - END - SUBROUTINE FI7503 (IWORK,IPFLD,NPTS,IBDSFL,BDS11, - * LEN,LENBDS,PDS,REFNCE,ISCAL2,KWIDE,IGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7501 ROW BY ROW, COL BY COL PACKING -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 94-05-20 -C -C ABSTRACT: PERFORM ROW BY ROW OR COLUMN BY COLUMN PACKING -C GENERATING ALL BDS INFORMATION. -C -C PROGRAM HISTORY LOG: -C 93-08-06 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI7503 (IWORK,IPFLD,NPTS,IBDSFL,BDS11, -C * LEN,LENBDS,PDS,REFNCE,ISCAL2,KWIDE,IGDS) -C INPUT ARGUMENT LIST: -C IWORK - INTEGER SOURCE ARRAY -C NPTS - NUMBER OF POINTS IN IWORK -C IBDSFL - FLAGS -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C IPFLD - CONTAINS BDS FROM BYTE 12 ON -C BDS11 - CONTAINS FIRST 11 BYTES FOR BDS -C LEN - NUMBER OF BYTES FROM 12 ON -C LENBDS - TOTAL LENGTH OF BDS -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - CHARACTER*1 BDS11(*),PDS(*),IPFLD(*) -C - REAL REFNCE -C - INTEGER ISCAL2,KWIDE - INTEGER LENBDS - INTEGER IGDS(*) - INTEGER LEN,KBDS(22) - INTEGER IWORK(*) -C OCTET NUMBER IN SECTION, FIRST ORDER PACKING -C INTEGER KBDS(12) -C FLAGS - INTEGER IBDSFL(*) -C EXTENDED FLAGS -C INTEGER KBDS(14) -C OCTET NUMBER FOR SECOND ORDER PACKING -C INTEGER KBDS(15) -C NUMBER OF FIRST ORDER VALUES -C INTEGER KBDS(17) -C NUMBER OF SECOND ORDER PACKED VALUES -C INTEGER KBDS(19) -C WIDTH OF SECOND ORDER PACKING - character(len=1) ISOWID(400000) -C SECONDARY BIT MAP - character(len=1) ISOBMP(65600) -C FIRST ORDER PACKED VALUES - character(len=1) IFOVAL(400000) -C SECOND ORDER PACKED VALUES - character(len=1) ISOVAL(800000) -C -C INTEGER KBDS(11) -C ---------------------------------- -C INITIALIZE ARRAYS -C - DO I = 1, 400000 - IFOVAL(I) = char(0) - ISOWID(I) = char(0) - ENDDO -C - DO 101 I = 1, 65600 - ISOBMP(I) = char(0) - 101 CONTINUE - DO 102 I = 1, 800000 - ISOVAL(I) = char(0) - 102 CONTINUE -C INITIALIZE POINTERS -C SECONDARY BIT WIDTH POINTER - IWDPTR = 0 -C SECONDARY BIT MAP POINTER - IBMP2P = 0 -C FIRST ORDER VALUE POINTER - IFOPTR = 0 -C BYTE POINTER TO START OF 1ST ORDER VALUES - KBDS(12) = 0 -C BYTE POINTER TO START OF 2ND ORDER VALUES - KBDS(15) = 0 -C TO CONTAIN NUMBER OF FIRST ORDER VALUES - KBDS(17) = 0 -C TO CONTAIN NUMBER OF SECOND ORDER VALUES - KBDS(19) = 0 -C SECOND ORDER PACKED VALUE POINTER - ISOPTR = 0 -C ======================================================= -C BUILD SECOND ORDER BIT MAP IN EITHER -C ROW BY ROW OR COL BY COL FORMAT - IF (IAND(IGDS(13),32).NE.0) THEN -C COLUMN BY COLUMN - KOUT = IGDS(4) - KIN = IGDS(5) -C PRINT *,'COLUMN BY COLUMN',KOUT,KIN - ELSE -C ROW BY ROW - KOUT = IGDS(5) - KIN = IGDS(4) -C PRINT *,'ROW BY ROW',KOUT,KIN - END IF - KBDS(17) = KOUT - KBDS(19) = NPTS -C -C DO 4100 J = 1, NPTS, 53 -C WRITE (6,4101) (IWORK(K),K=J,J+52) - 4101 FORMAT (1X,25I4) -C PRINT *,' ' -C4100 CONTINUE -C -C INITIALIZE BIT MAP POINTER - IBMP2P = 0 -C CONSTRUCT WORKING BIT MAP - DO 2000 I = 1, KOUT - DO 1000 J = 1, KIN - IF (J.EQ.1) THEN - CALL SBYTEC (ISOBMP,1,IBMP2P,1) - ELSE - CALL SBYTEC (ISOBMP,0,IBMP2P,1) - END IF - IBMP2P = IBMP2P + 1 - 1000 CONTINUE - 2000 CONTINUE - LEN = IBMP2P / 32 + 1 -C CALL BINARY(ISOBMP,LEN) -C -C PROCESS OUTER LOOP OF ROW BY ROW OR COL BY COL -C - KPTR = 1 - KBDS(11) = KWIDE - DO 6000 I = 1, KOUT -C IN CURRENT ROW OR COL -C FIND FIRST ORDER VALUE - JPTR = KPTR - LOWEST = IWORK(JPTR) - DO 4000 J = 1, KIN - IF (IWORK(JPTR).LT.LOWEST) THEN - LOWEST = IWORK(JPTR) - END IF - JPTR = JPTR + 1 - 4000 CONTINUE -C SAVE FIRST ORDER VALUE - CALL SBYTEC (IFOVAL,LOWEST,IFOPTR,KWIDE) - IFOPTR = IFOPTR + KWIDE -C PRINT *,'FOVAL',I,LOWEST,KWIDE -C SUBTRACT FIRST ORDER VALUE FROM OTHER VALS -C GETTING SECOND ORDER VALUES - JPTR = KPTR - IBIG = IWORK(JPTR) - LOWEST - DO 4200 J = 1, KIN - IWORK(JPTR) = IWORK(JPTR) - LOWEST - IF (IWORK(JPTR).GT.IBIG) THEN - IBIG = IWORK(JPTR) - END IF - JPTR = JPTR + 1 - 4200 CONTINUE -C HOW MANY BITS TO CONTAIN LARGEST SECOND -C ORDER VALUE IN SEGMENT - CALL FI7505 (IBIG,NWIDE) -C SAVE BIT WIDTH - CALL SBYTEC (ISOWID,NWIDE,IWDPTR,8) - IWDPTR = IWDPTR + 8 -C PRINT *,I,'SOVAL',IBIG,' IN',NWIDE,' BITS' -C WRITE (6,4101) (IWORK(K),K=KPTR,KPTR+52) -C SAVE SECOND ORDER VALUES OF THIS SEGMENT - DO 5000 J = 0, KIN-1 - CALL SBYTEC (ISOVAL,IWORK(KPTR+J),ISOPTR,NWIDE) - ISOPTR = ISOPTR + NWIDE - 5000 CONTINUE - KPTR = KPTR + KIN - 6000 CONTINUE -C ======================================================= -C CONCANTENATE ALL FIELDS FOR BDS -C -C REMAINDER GOES INTO IPFLD - IPTR = 0 -C BYTES 12-13 -C VALUE FOR N1 -C LEAVE SPACE FOR THIS - IPTR = IPTR + 16 -C BYTE 14 -C EXTENDED FLAGS - CALL SBYTEC (IPFLD,IBDSFL(5),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(6),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(7),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(8),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(9),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(10),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(11),IPTR,1) - IPTR = IPTR + 1 - CALL SBYTEC (IPFLD,IBDSFL(12),IPTR,1) - IPTR = IPTR + 1 -C BYTES 15-16 -C SKIP OVER VALUE FOR N2 - IPTR = IPTR + 16 -C BYTES 17-18 -C P1 - CALL SBYTEC (IPFLD,KBDS(17),IPTR,16) - IPTR = IPTR + 16 -C BYTES 19-20 -C P2 - CALL SBYTEC (IPFLD,KBDS(19),IPTR,16) - IPTR = IPTR + 16 -C BYTE 21 - RESERVED LOCATION - CALL SBYTEC (IPFLD,0,IPTR,8) - IPTR = IPTR + 8 -C BYTES 22 - ? -C WIDTHS OF SECOND ORDER PACKING - IX = (IWDPTR + 32) / 32 -C CALL SBYTESC (IPFLD,ISOWID,IPTR,32,0,IX) - ijk=IWDPTR/8 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=ISOWID(1:ijk) - IPTR = IPTR + IWDPTR -C PRINT *,'ISOWID',IWDPTR,IX -C CALL BINARY (ISOWID,IX) -C -C NO SECONDARY BIT MAP - -C DETERMINE LOCATION FOR START -C OF FIRST ORDER PACKED VALUES - KBDS(12) = IPTR / 8 + 12 -C STORE LOCATION - CALL SBYTEC (IPFLD,KBDS(12),0,16) -C MOVE IN FIRST ORDER PACKED VALUES - IPASS = (IFOPTR + 32) / 32 -c CALL SBYTESC (IPFLD,IFOVAL,IPTR,32,0,IPASS) - ijk=(IFOPTR/8)+1 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=ifoval(1:ijk) - IPTR = IPTR + IFOPTR -C PRINT *,'IFOVAL',IFOPTR,IPASS,KWIDE -C CALL BINARY (IFOVAL,IPASS) - IF (MOD(IPTR,8).NE.0) THEN - IPTR = IPTR + 8 - MOD(IPTR,8) - END IF -C PRINT *,'IFOPTR =',IFOPTR,' ISOPTR =',ISOPTR -C DETERMINE LOCATION FOR START -C OF SECOND ORDER VALUES - KBDS(15) = IPTR / 8 + 12 -C SAVE LOCATION OF SECOND ORDER VALUES - CALL SBYTEC (IPFLD,KBDS(15),24,16) -C MOVE IN SECOND ORDER PACKED VALUES - IX = (ISOPTR + 32) / 32 -C CALL SBYTESC (IPFLD,ISOVAL,IPTR,32,0,IX) - ijk=(ISOPTR/8)+1 - jst=(iptr/8)+1 - ipfld(jst:jst+ijk)=isoval(1:ijk) - IPTR = IPTR + ISOPTR -C PRINT *,'ISOVAL',ISOPTR,IX -C CALL BINARY (ISOVAL,IX) - NLEFT = MOD(IPTR+88,16) - IF (NLEFT.NE.0) THEN - NLEFT = 16 - NLEFT - IPTR = IPTR + NLEFT - END IF -C COMPUTE LENGTH OF DATA PORTION - LEN = IPTR / 8 -C COMPUTE LENGTH OF BDS - LENBDS = LEN + 11 -C ----------------------------------- -C BYTES 1-3 -C THIS FUNCTION COMPLETED BELOW -C WHEN LENGTH OF BDS IS KNOWN - CALL SBYTEC (BDS11,LENBDS,0,24) -C BYTE 4 - CALL SBYTEC (BDS11,IBDSFL(1),24,1) - CALL SBYTEC (BDS11,IBDSFL(2),25,1) - CALL SBYTEC (BDS11,IBDSFL(3),26,1) - CALL SBYTEC (BDS11,IBDSFL(4),27,1) -C ENTER NUMBER OF FILL BITS - CALL SBYTEC (BDS11,NLEFT,28,4) -C BYTE 5-6 - IF (ISCAL2.LT.0) THEN - CALL SBYTEC (BDS11,1,32,1) - ISCAL2 = - ISCAL2 - ELSE - CALL SBYTEC (BDS11,0,32,1) - END IF - CALL SBYTEC (BDS11,ISCAL2,33,15) -C -C$ FILL OCTET 7-10 WITH THE REFERENCE VALUE -C CONVERT THE FLOATING POINT OF YOUR MACHINE TO IBM370 32 BIT -C FLOATING POINT NUMBER -C REFERENCE VALUE -C FIRST TEST TO SEE IF -C ON 32 OR 64 BIT COMPUTER -C CALL W3FI01(LW) - IF (bit_size(LW).EQ.32) THEN - CALL W3FI76 (REFNCE,IEXP,IMANT,32) - ELSE - CALL W3FI76 (REFNCE,IEXP,IMANT,64) - END IF - CALL SBYTEC (BDS11,IEXP,48,8) - CALL SBYTEC (BDS11,IMANT,56,24) -C -C BYTE 11 -C - CALL SBYTEC (BDS11,KBDS(11),80,8) -C - KLEN = LENBDS / 4 + 1 -C PRINT *,'BDS11 LISTING',4,LENBDS -C CALL BINARY (BDS11,4) -C PRINT *,'IPFLD LISTING' -C CALL BINARY (IPFLD,KLEN) - RETURN - END - SUBROUTINE FI7505 (N,NBITS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7505 DETERMINE NUMBER OF BITS TO CONTAIN VALUE -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 93-06-23 -C -C ABSTRACT: CALCULATE NUMBER OF BITS TO CONTAIN VALUE N, WITH A -C MAXIMUM OF 32 BITS. -C -C PROGRAM HISTORY LOG: -C 93-06-23 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI7505 (N,NBITS) -C INPUT ARGUMENT LIST: -C N - INTEGER VALUE -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C NBITS - NUMBER OF BITS TO CONTAIN N -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - INTEGER N,NBITS - INTEGER IBITS(31) -C - DATA IBITS/1,3,7,15,31,63,127,255,511,1023,2047, - * 4095,8191,16383,32767,65535,131071,262143, - * 524287,1048575,2097151,4194303,8388607, - * 16777215,33554431,67108863,134217727,268435455, - * 536870911,1073741823,2147483647/ -C ---------------------------------------------------------------- -C - DO 1000 NBITS = 1, 31 - IF (N.LE.IBITS(NBITS)) THEN - RETURN - END IF - 1000 CONTINUE - RETURN - END - SUBROUTINE FI7513 (IWORK,ISTART,NPTS,MAX,MIN,INRNGE) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7513 SELECT BLOCK OF DATA FOR PACKING -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 94-01-21 -C -C ABSTRACT: SELECT A BLOCK OF DATA FOR PACKING -C -C PROGRAM HISTORY LOG: -C 94-01-21 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI7513 (IWORK,ISTART,NPTS,MAX,MIN,INRNGE) -C INPUT ARGUMENT LIST: -C * - RETURN ADDRESS IF ENCOUNTER SET OF SAME VALUES -C IWORK - -C ISTART - -C NPTS - -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C MAX - -C MIN - -C INRNGE - -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - INTEGER IWORK(*),NPTS,ISTART,INRNGE,INRNGA,INRNGB - INTEGER MAX,MIN,MXVAL,MAXB,MINB,MXVALB - INTEGER IBITS(31) -C - DATA IBITS/1,3,7,15,31,63,127,255,511,1023,2047, - * 4095,8191,16383,32767,65535,131071,262143, - * 524287,1048575,2097151,4194303,8388607, - * 16777215,33554431,67108863,134217727,268435455, - * 536870911,1073741823,2147483647/ -C ---------------------------------------------------------------- -C IDENTIFY NEXT BLOCK OF DATA FOR PACKING AND -C RETURN TO CALLER -C ******************************************************************** - ISTRTA = ISTART -C -C GET BLOCK A - CALL FI7516 (IWORK,NPTS,INRNGA,ISTRTA, - * MAX,MIN,MXVAL,LWIDE) -C ******************************************************************** -C - ISTRTB = ISTRTA + INRNGA - 2000 CONTINUE -C IF HAVE PROCESSED ALL DATA, RETURN - IF (ISTRTB.GT.NPTS) THEN -C NO MORE DATA TO LOOK AT - INRNGE = INRNGA - RETURN - END IF -C GET BLOCK B - CALL FI7502 (IWORK,ISTRTB,NPTS,ISAME) - IF (ISAME.GE.15) THEN -C PRINT *,'BLOCK B HAS ALL IDENTICAL VALUES' -C PRINT *,'BLOCK A HAS INRNGE =',INRNGA -C BLOCK B CONTAINS ALL IDENTICAL VALUES - INRNGE = INRNGA -C EXIT WITH BLOCK A - RETURN - END IF -C GET BLOCK B -C - ISTRTB = ISTRTA + INRNGA - CALL FI7516 (IWORK,NPTS,INRNGB,ISTRTB, - * MAXB,MINB,MXVALB,LWIDEB) -C PRINT *,'BLOCK A',INRNGA,' BLOCK B',INRNGB -C ******************************************************************** -C PERFORM TREND ANALYSIS TO DETERMINE -C IF DATA COLLECTION CAN BE IMPROVED -C - KTRND = LWIDE - LWIDEB -C PRINT *,'TREND',LWIDE,LWIDEB - IF (KTRND.LE.0) THEN -C PRINT *,'BLOCK A - SMALLER, SHOULD EXTEND INTO BLOCK B' - MXVAL = IBITS(LWIDE) -C -C IF BLOCK A REQUIRES THE SAME OR FEWER BITS -C LOOK AHEAD -C AND GATHER THOSE DATA POINTS THAT CAN -C BE RETAINED IN BLOCK A -C BECAUSE THIS BLOCK OF DATA -C USES FEWER BITS -C - CALL FI7518 (IRET,IWORK,NPTS,ISTRTA,INRNGA,INRNGB, - * MAX,MIN,LWIDE,MXVAL) - IF(IRET.EQ.1) GO TO 8000 -C PRINT *,'18 INRNGA IS NOW ',INRNGA - IF (INRNGB.LT.20) THEN - RETURN - ELSE - GO TO 2000 - END IF - ELSE -C PRINT *,'BLOCK A - LARGER, B SHOULD EXTEND BACK INTO A' - MXVALB = IBITS(LWIDEB) -C -C IF BLOCK B REQUIRES FEWER BITS -C LOOK BACK -C SHORTEN BLOCK A BECAUSE NEXT BLOCK OF DATA -C USES FEWER BITS -C - CALL FI7517 (IRET,IWORK,NPTS,ISTRTB,INRNGA, - * MAXB,MINB,LWIDEB,MXVALB) - IF(IRET.EQ.1) GO TO 8000 -C PRINT *,'17 INRNGA IS NOW ',INRNGA - END IF -C -C PACK UP BLOCK A -C UPDATA POINTERS - 8000 CONTINUE - INRNGE = INRNGA -C GET NEXT BLOCK A - 9000 CONTINUE - RETURN - END - SUBROUTINE FI7516 (IWORK,NPTS,INRNG,ISTART,MAX,MIN,MXVAL,LWIDTH) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7516 SCAN NUMBER OF POINTS -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 94-01-21 -C -C ABSTRACT: SCAN FORWARD FROM CURRENT POSITION. COLLECT POINTS AND -C DETERMINE MAXIMUM AND MINIMUM VALUES AND THE NUMBER -C OF POINTS THAT ARE INCLUDED. FORWARD SEARCH IS TERMINATED -C BY ENCOUNTERING A SET OF IDENTICAL VALUES, BY REACHING -C THE NUMBER OF POINTS SELECTED OR BY REACHING THE END -C OF DATA. -C -C PROGRAM HISTORY LOG: -C 94-01-21 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL FI7516 (IWORK,NPTS,INRNG,ISTART,MAX,MIN,MXVAL,LWIDTH) -C INPUT ARGUMENT LIST: -C * - RETURN ADDRESS IF ENCOUNTER SET OF SAME VALUES -C IWORK - DATA ARRAY -C NPTS - NUMBER OF POINTS IN DATA ARRAY -C ISTART - STARTING LOCATION IN DATA -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C INRNG - NUMBER OF POINTS SELECTED -C MAX - MAXIMUM VALUE OF POINTS -C MIN - MINIMUM VALUE OF POINTS -C MXVAL - MAXIMUM VALUE THAT CAN BE CONTAINED IN LWIDTH BITS -C LWIDTH - NUMBER OF BITS TO CONTAIN MAX DIFF -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - INTEGER IWORK(*),NPTS,ISTART,INRNG,MAX,MIN,LWIDTH,MXVAL - INTEGER IBITS(31) -C - DATA IBITS/1,3,7,15,31,63,127,255,511,1023,2047, - * 4095,8191,16383,32767,65535,131071,262143, - * 524287,1048575,2097151,4194303,8388607, - * 16777215,33554431,67108863,134217727,268435455, - * 536870911,1073741823,2147483647/ -C ---------------------------------------------------------------- -C - INRNG = 1 - JQ = ISTART + 19 - MAX = IWORK(ISTART) - MIN = IWORK(ISTART) - DO 1000 I = ISTART+1, JQ - CALL FI7502 (IWORK,I,NPTS,ISAME) - IF (ISAME.GE.15) THEN - GO TO 5000 - END IF - INRNG = INRNG + 1 - IF (IWORK(I).GT.MAX) THEN - MAX = IWORK(I) - ELSE IF (IWORK(I).LT.MIN) THEN - MIN = IWORK(I) - END IF - 1000 CONTINUE - 5000 CONTINUE - KRNG = MAX - MIN -C - DO 9000 LWIDTH = 1, 31 - IF (KRNG.LE.IBITS(LWIDTH)) THEN -C PRINT *,'RETURNED',INRNG,' VALUES' - RETURN - END IF - 9000 CONTINUE - RETURN - END - SUBROUTINE FI7517 (IRET,IWORK,NPTS,ISTRTB,INRNGA, - * MAXB,MINB,MXVALB,LWIDEB) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7517 SCAN BACKWARD -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 94-01-21 -C -C ABSTRACT: SCAN BACKWARDS UNTIL A VALUE EXCEEDS RANGE OF GROUP B -C THIS MAY SHORTEN GROUP A -C -C PROGRAM HISTORY LOG: -C 94-01-21 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-06-17 IREDELL REMOVED ALTERNATE RETURN -C -C USAGE: CALL FI7517 (IRET,IWORK,NPTS,ISTRTB,INRNGA, -C * MAXB,MINB,MXVALB,LWIDEB) -C INPUT ARGUMENT LIST: -C IWORK - -C ISTRTB - -C NPTS - -C INRNGA - -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C IRET - -C JLAST - -C MAXB - -C MINB - -C LWIDTH - NUMBER OF BITS TO CONTAIN MAX DIFF -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - INTEGER IWORK(*),NPTS,ISTRTB,INRNGA - INTEGER MAXB,MINB,LWIDEB,MXVALB - INTEGER IBITS(31) -C - DATA IBITS/1,3,7,15,31,63,127,255,511,1023,2047, - * 4095,8191,16383,32767,65535,131071,262143, - * 524287,1048575,2097151,4194303,8388607, - * 16777215,33554431,67108863,134217727,268435455, - * 536870911,1073741823,2147483647/ -C ---------------------------------------------------------------- - IRET=0 -C PRINT *,' FI7517' - NPOS = ISTRTB - 1 - ITST = 0 - KSET = INRNGA -C - 1000 CONTINUE -C PRINT *,'TRY NPOS',NPOS,IWORK(NPOS),MAXB,MINB - ITST = ITST + 1 - IF (ITST.LE.KSET) THEN - IF (IWORK(NPOS).GT.MAXB) THEN - IF ((IWORK(NPOS)-MINB).GT.MXVALB) THEN -C PRINT *,'WENT OUT OF RANGE AT',NPOS - IRET=1 - RETURN - ELSE - MAXB = IWORK(NPOS) - END IF - ELSE IF (IWORK(NPOS).LT.MINB) THEN - IF ((MAXB-IWORK(NPOS)).GT.MXVALB) THEN -C PRINT *,'WENT OUT OF RANGE AT',NPOS - IRET=1 - RETURN - ELSE - MINB = IWORK(NPOS) - END IF - END IF - INRNGA = INRNGA - 1 - NPOS = NPOS - 1 - GO TO 1000 - END IF -C ---------------------------------------------------------------- -C - 9000 CONTINUE - RETURN - END - SUBROUTINE FI7518 (IRET,IWORK,NPTS,ISTRTA,INRNGA,INRNGB, - * MAXA,MINA,LWIDEA,MXVALA) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: FI7518 SCAN FORWARD -C PRGMMR: CAVANAUGH ORG: W/NMC42 DATE: 94-01-21 -C -C ABSTRACT: SCAN FORWARD FROM START OF BLOCK B TOWARDS END OF BLOCK B -C IF NEXT POINT UNDER TEST FORCES A LARGER MAXVALA THEN -C TERMINATE INDICATING LAST POINT TESTED FOR INCLUSION -C INTO BLOCK A. -C -C PROGRAM HISTORY LOG: -C 94-01-21 CAVANAUGH -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-06-17 IREDELL REMOVED ALTERNATE RETURN -C -C USAGE: CALL FI7518 (IRET,IWORK,NPTS,ISTRTA,INRNGA,INRNGB, -C * MAXA,MINA,LWIDEA,MXVALA) -C INPUT ARGUMENT LIST: -C IFLD - -C JSTART - -C NPTS - -C -C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) -C IRET - -C JLAST - -C MAX - -C MIN - -C LWIDTH - NUMBER OF BITS TO CONTAIN MAX DIFF -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916/256, Y-MP8/64, Y-MP EL92/256 -C -C$$$ - INTEGER IWORK(*),NPTS,ISTRTA,INRNGA - INTEGER MAXA,MINA,LWIDEA,MXVALA - INTEGER IBITS(31) -C - DATA IBITS/1,3,7,15,31,63,127,255,511,1023,2047, - * 4095,8191,16383,32767,65535,131071,262143, - * 524287,1048575,2097151,4194303,8388607, - * 16777215,33554431,67108863,134217727,268435455, - * 536870911,1073741823,2147483647/ -C ---------------------------------------------------------------- - IRET=0 -C PRINT *,' FI7518' - NPOS = ISTRTA + INRNGA - ITST = 0 -C - 1000 CONTINUE - ITST = ITST + 1 - IF (ITST.LE.INRNGB) THEN -C PRINT *,'TRY NPOS',NPOS,IWORK(NPOS),MAXA,MINA - IF (IWORK(NPOS).GT.MAXA) THEN - IF ((IWORK(NPOS)-MINA).GT.MXVALA) THEN -C PRINT *,'FI7518A -',ITST,' RANGE EXCEEDS MAX' - IRET=1 - RETURN - ELSE - MAXA = IWORK(NPOS) - END IF - ELSE IF (IWORK(NPOS).LT.MINA) THEN - IF ((MAXA-IWORK(NPOS)).GT.MXVALA) THEN -C PRINT *,'FI7518B -',ITST,' RANGE EXCEEDS MAX' - IRET=1 - RETURN - ELSE - MINA = IWORK(NPOS) - END IF - END IF - INRNGA = INRNGA + 1 -C PRINT *,' ',ITST,INRNGA - NPOS = NPOS +1 - GO TO 1000 - END IF -C ---------------------------------------------------------------- - 9000 CONTINUE - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi76.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi76.f deleted file mode 100755 index 2a1553f51c..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi76.f +++ /dev/null @@ -1,131 +0,0 @@ - SUBROUTINE W3FI76(PVAL,KEXP,KMANT,KBITS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI76 CONVERT TO IBM370 FLOATING POINT -C PRGMMR: REJONES ORG: NMC421 DATE:92-11-16 -C -C ABSTRACT: CONVERTS FLOATING POINT NUMBER FROM MACHINE -C REPRESENTATION TO GRIB REPRESENTATION (IBM370 32 BIT F.P.). -C -C PROGRAM HISTORY LOG: -C 85-09-15 JOHN HENNESSY ECMWF -C 92-09-23 JONES R. E. CHANGE NAME, ADD DOC BLOCK -C 93-10-27 JONES,R. E. CHANGE TO AGREE WITH HENNESSY CHANGES -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C 98-03-10 B. VUONG REMOVE THE CDIR$ INTEGER=64 DIRECTIVE -C -C USAGE: CALL W3FI76 (FVAL, KEXP, KMANT, NBITS) -C INPUT ARGUMENT LIST: -C PVAL - FLOATING POINT NUMBER TO BE CONVERTED -C KBITS - NUMBER OF BITS IN COMPUTER WORD (32 OR 64) -C -C OUTPUT ARGUMENT LIST: -C KEXP - 8 BIT SIGNED EXPONENT -C KMANT - 24 BIT MANTISSA (FRACTION) -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM370 VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS 9000, CRAY Y-MP8/864< CRAY Y-MP EL2/256 -C -C$$$ -C -C******************************************************************** -C* -C* NAME : CONFP3 -C* -C* FUNCTION : CONVERT FLOATING POINT NUMBER FROM MACHINE -C* REPRESENTATION TO GRIB REPRESENTATION. -C* -C* INPUT : PVAL - FLOATING POINT NUMBER TO BE CONVERTED. -C* KBITS : KBITS - NUMBER OF BITS IN COMPUTER WORD -C* -C* OUTPUT : KEXP - 8 BIT SIGNED EXPONENT -C* KMANT - 24 BIT MANTISSA -C* PVAL - UNCHANGED. -C* -C* JOHN HENNESSY , ECMWF 18.06.91 -C* -C******************************************************************** -C -C -C IMPLICIT NONE -C - INTEGER IEXP - INTEGER ISIGN -C - INTEGER KBITS - INTEGER KEXP - INTEGER KMANT -C - REAL PVAL - REAL ZEPS - REAL ZREF -C -C TEST FOR FLOATING POINT ZERO -C - IF (PVAL.EQ.0.0) THEN - KEXP = 0 - KMANT = 0 - GO TO 900 - ENDIF -C -C SET ZEPS TO 1.0E-12 FOR 64 BIT COMPUTERS (CRAY) -C SET ZEPS TO 1.0E-8 FOR 32 BIT COMPUTERS -C - IF (KBITS.EQ.32) THEN - ZEPS = 1.0E-8 - ELSE - ZEPS = 1.0E-12 - ENDIF - ZREF = PVAL -C -C SIGN OF VALUE -C - ISIGN = 0 - IF (ZREF.LT.0.0) THEN - ISIGN = 128 - ZREF = - ZREF - ENDIF -C -C EXPONENT -C - IEXP = INT(ALOG(ZREF)*(1.0/ALOG(16.0))+64.0+1.0+ZEPS) -C - IF (IEXP.LT.0 ) IEXP = 0 - IF (IEXP.GT.127) IEXP = 127 -C -C MANTISSA -C -C CLOSEST NUMBER IN GRIB FORMAT TO ORIGINAL NUMBER -C (EQUAL TO, GREATER THAN OR LESS THAN ORIGINAL NUMBER). -C - KMANT = NINT (ZREF/16.0**(IEXP-70)) -C -C CHECK THAT MANTISSA VALUE DOES NOT EXCEED 24 BITS -C 16777215 = 2**24 - 1 -C - IF (KMANT.GT.16777215) THEN - IEXP = IEXP + 1 -C -C CLOSEST NUMBER IN GRIB FORMAT TO ORIGINAL NUMBER -C (EQUAL TO, GREATER THAN OR LESS THAN ORIGINAL NUMBER). -C - KMANT = NINT (ZREF/16.0**(IEXP-70)) -C -C CHECK MANTISSA VALUE DOES NOT EXCEED 24 BITS AGAIN -C - IF (KMANT.GT.16777215) THEN - PRINT *,'BAD MANTISSA VALUE FOR PVAL = ',PVAL - ENDIF - ENDIF -C -C ADD SIGN BIT TO EXPONENT. -C - KEXP = IEXP + ISIGN -C - 900 CONTINUE -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi82.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi82.f deleted file mode 100755 index 56a5ccc353..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi82.f +++ /dev/null @@ -1,97 +0,0 @@ - SUBROUTINE W3FI82 (IFLD,FVAL1,FDIFF1,NPTS,PDS,IGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI82 CONVERT TO SECOND DIFF ARRAY -C PRGMMR: CAVANAUGH ORG: NMC421 DATE:93-08-18 -C -C ABSTRACT: ACCEPT AN INPUT ARRAY, CONVERT TO ARRAY OF SECOND -C DIFFERENCES. RETURN THE ORIGINAL FIRST VALUE AND THE FIRST -C FIRST-DIFFERENCE AS SEPARATE VALUES. ALIGN DATA IN -C BOUSTREPHEDONIC STYLE, (ALTERNATE ROW REVERSAL). -C -C PROGRAM HISTORY LOG: -C 93-07-14 CAVANAUGH -C 94-01-27 CAVANAUGH ADDED REVERSAL OF EVEN NUMBERED ROWS -C (BOUSTROPHEDONIC PROCESSING) -C 94-03-02 CAVANAUGH CORRECTED IMPROPER ORDERING OF EVEN -C NUMBERED ROWS -C 99-12-06 EBISUZAKI LINUX PORT -C -C USAGE: CALL W3FI82 (IFLD,FVAL1,FDIFF1,NPTS,PDS,IGDS) -C INPUT ARGUMENT LIST: -C IFLD - INTEGER INPUT ARRAY -C NPTS - NUMBER OF POINTS IN ARRAY -C IGDS(5) - NUMBER OF ROWS IN ARRAY -C IGDS(4) - NUMBER OF COLUMNS IN ARRAY -C PDS(8) - FLAG INDICATING PRESENCE OF GDS SECTION -C -C OUTPUT ARGUMENT LIST: -C IFLD - SECOND DIFFERENCED FIELD -C FVAL1 - FLOATING POINT ORIGINAL FIRST VALUE -C FDIFF1 - " " FIRST FIRST-DIFFERENCE -C -C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION -C -C ATTRIBUTES: -C LANGUAGE: IBM370 VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916-128, CRAY Y-MP8/864, CRAY Y-MP EL2/256 -C -C$$$ -C - REAL FVAL1,FDIFF1 -C - INTEGER IFLD(*),NPTS,NBOUST(300),IGDS(*) -C - CHARACTER*1 PDS(*) -C -C --------------------------------------------- -C TEST FOR PRESENCE OF GDS -C -c looks like an error CALL GBYTE(PDS,IQQ,56,8) - call gbytec(PDS,IQQ,56,1) - IF (IQQ.NE.0) THEN - NROW = IGDS(5) - NCOL = IGDS(4) -C -C LAY OUT DATA BOUSTROPHEDONIC STYLE -C -C PRINT*, ' DATA SET UP BOUSTROPHEDON' -C - DO 210 I = 2, NROW, 2 -C -C REVERSE THE EVEN NUMBERED ROWS -C - DO 200 J = 1, NCOL - NPOS = I * NCOL - J + 1 - NBOUST(J) = IFLD(NPOS) - 200 CONTINUE - DO 201 J = 1, NCOL - NPOS = NCOL * (I-1) + J - IFLD(NPOS) = NBOUST(J) - 201 CONTINUE - 210 CONTINUE -C -C - END IF -C ================================================================= - DO 4000 I = NPTS, 2, -1 - IFLD(I) = IFLD(I) - IFLD(I-1) - 4000 CONTINUE - DO 5000 I = NPTS, 3, -1 - IFLD(I) = IFLD(I) - IFLD(I-1) - 5000 CONTINUE -C -C SPECIAL FOR GRIB -C FLOAT OUTPUT OF FIRST POINTS TO ANTICIPATE -C GRIB FLOATING POINT OUTPUT -C - FVAL1 = IFLD(1) - FDIFF1 = IFLD(2) -C -C SET FIRST TWO POINTS TO SECOND DIFF VALUE FOR BETTER PACKING -C - IFLD(1) = IFLD(3) - IFLD(2) = IFLD(3) -C ----------------------------------------------------------- - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi83.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi83.f deleted file mode 100755 index 510c61e48f..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fi83.f +++ /dev/null @@ -1,108 +0,0 @@ - SUBROUTINE W3FI83 (DATA,NPTS,FVAL1,FDIFF1,ISCAL2, - * ISC10,KPDS,KGDS) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FI83 RESTORE DELTA PACKED DATA TO ORIGINAL -C PRGMMR: CAVANAUGH ORG: NMC421 DATE:93-08-18 -C -C ABSTRACT: RESTORE DELTA PACKED DATA TO ORIGINAL VALUES -C RESTORE FROM BOUSTREPHEDONIC ALIGNMENT -C -C PROGRAM HISTORY LOG: -C 93-07-14 CAVANAUGH -C 93-07-22 STACKPOLE ADDITIONS TO FIX SCALING -C 94-01-27 CAVANAUGH ADDED REVERSAL OF EVEN NUMBERED ROWS -C (BOUSTROPHEDONIC PROCESSING) TO RESTORE -C DATA TO ORIGINAL SEQUENCE. -C 94-03-02 CAVANAUGH CORRECTED REVERSAL OF EVEN NUMBERED ROWS -C 95-10-31 IREDELL REMOVED SAVES AND PRINTS -C -C USAGE: CALL W3FI83(DATA,NPTS,FVAL1,FDIFF1,ISCAL2, -C * ISC10,KPDS,KGDS) -C INPUT ARGUMENT LIST: -C DATA - SECOND ORDER DIFFERENCES -C NPTS - NUMBER OF POINTS IN ARRAY -C FVAL1 - ORIGINAL FIRST ENTRY IN ARRAY -C FDIFF1 - ORIGINAL FIRST FIRST-DIFFERENCE -C ISCAL2 - POWER-OF-TWO EXPONENT FOR UNSCALING -C ISC10 - POWER-OF-TEN EXPONENT FOR UNSCALING -C KPDS - ARRAY OF INFORMATION FOR PDS -C KGDS - ARRAY OF INFORMATION FOR GDS -C -C OUTPUT ARGUMENT LIST: -C DATA - EXPANDED ORIGINAL DATA VALUES -C -C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. -C -C ATTRIBUTES: -C LANGUAGE: IBM VS FORTRAN 77, CRAY CFT77 FORTRAN -C MACHINE: HDS, CRAY C916-128, CRAY Y-MP8/864, CRAY Y-MP EL2/256 -C -C$$$ -C - REAL FVAL1,FDIFF1 - REAL DATA(*),BOUST(200) - INTEGER NPTS,NROW,NCOL,KPDS(*),KGDS(*),ISC10 -C --------------------------------------- -C -C REMOVE DECIMAL UN-SCALING INTRODUCED DURING UNPACKING -C - DSCAL = 10.0 ** ISC10 - IF (DSCAL.EQ.0.0) THEN - DO 50 I=1,NPTS - DATA(I) = 1.0 - 50 CONTINUE - ELSE IF (DSCAL.EQ.1.0) THEN - ELSE - DO 51 I=1,NPTS - DATA(I) = DATA(I) * DSCAL - 51 CONTINUE - END IF -C - DATA(1) = FVAL1 - DATA(2) = FDIFF1 - DO 200 J = 3,2,-1 - DO 100 K = J, NPTS - DATA(K) = DATA(K) + DATA(K-1) - 100 CONTINUE - 200 CONTINUE -C -C NOW REMOVE THE BINARY SCALING FROM THE RECONSTRUCTED FIELD -C AND THE DECIMAL SCALING TOO -C - IF (DSCAL.EQ.0) THEN - SCALE = 0.0 - ELSE - SCALE =(2.0**ISCAL2)/DSCAL - END IF - DO 300 I=1,NPTS - DATA(I) = DATA(I) * SCALE - 300 CONTINUE -C ========================================================== - IF (IAND(KPDS(4),128).NE.0) THEN - NROW = KGDS(3) - NCOL = KGDS(2) -C -C DATA LAID OUT BOUSTROPHEDONIC STYLE -C -C -C PRINT*, ' REVERSE BOUSTROPHEDON' - DO 210 I = 2, NROW, 2 -C -C REVERSE THE EVEN NUMBERED ROWS -C - DO 201 J = 1, NCOL - NPOS = I * NCOL - J + 1 - BOUST(J) = DATA(NPOS) - 201 CONTINUE - DO 202 J = 1, NCOL - NPOS = NCOL * (I-1) + J - DATA(NPOS) = BOUST(J) - 202 CONTINUE - 210 CONTINUE -C -C - END IF -C ================================================================= - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fs21.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fs21.f deleted file mode 100755 index 3593d6ffeb..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fs21.f +++ /dev/null @@ -1,77 +0,0 @@ - SUBROUTINE W3FS21(IDATE, NMIN) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C . . . . -C SUBPROGRAM: W3FS21 NUMBER OF MINUTES SINCE JAN 1, 1978 -C PRGMMR: REJONES ORG: NMC421 DATE: 89-07-17 -C -C ABSTRACT: CALCULATES THE NUMBER OF MINUTES SINCE 0000, -C 1 JANUARY 1978. -C -C PROGRAM HISTORY LOG: -C 84-06-21 A. DESMARAIS -C 89-07-14 R.E.JONES CONVERT TO CYBER 205 FORTRAN 200, -C CHANGE LOGIC SO IT WILL WORK IN -C 21 CENTURY. -C 89-11-02 R.E.JONES CONVERT TO CRAY CFT77 FORTRAN -C -C USAGE: CALL W3FS21 (IDATE, NMIN) -C INPUT ARGUMENT LIST: -C IDATE - INTEGER SIZE 5 ARRAY CONTAINING YEAR OF CENTURY, -C MONTH, DAY, HOUR AND MINUTE. IDATE(1) MAY BE -C A TWO DIGIT YEAR OR 4. IF 2 DIGITS AND GE THAN 78 -C 1900 IS ADDED TO IT. IF LT 78 THEN 2000 IS ADDED -C TO IT. IF 4 DIGITS THE SUBROUTINE WILL WORK -C CORRECTLY TO THE YEAR 3300 A.D. -C -C OUTPUT ARGUMENT LIST: -C NMIN - INTEGER NUMBER OF MINUTES SINCE 1 JANUARY 1978 -C -C SUBPROGRAMS CALLED: -C LIBRARY: -C W3LIB - IW3JDN -C -C ATTRIBUTES: -C LANGUAGE: CRAY CFT77 FORTRAN -C MACHINE: CRAY Y-MP8/832 -C -C$$$ -C - INTEGER IDATE(5) - INTEGER NMIN - INTEGER JDN78 -C - DATA JDN78 / 2443510 / -C -C*** IDATE(1) YEAR OF CENTURY -C*** IDATE(2) MONTH OF YEAR -C*** IDATE(3) DAY OF MONTH -C*** IDATE(4) HOUR OF DAY -C*** IDATE(5) MINUTE OF HOUR -C - NMIN = 0 -C - IYEAR = IDATE(1) -C - IF (IYEAR.LE.99) THEN - IF (IYEAR.LT.78) THEN - IYEAR = IYEAR + 2000 - ELSE - IYEAR = IYEAR + 1900 - ENDIF - ENDIF -C -C COMPUTE JULIAN DAY NUMBER FROM YEAR, MONTH, DAY -C - IJDN = IW3JDN(IYEAR,IDATE(2),IDATE(3)) -C -C SUBTRACT JULIAN DAY NUMBER OF JAN 1,1978 TO GET THE -C NUMBER OF DAYS BETWEEN DATES -C - NDAYS = IJDN - JDN78 -C -C*** NUMBER OF MINUTES -C - NMIN = NDAYS * 1440 + IDATE(4) * 60 + IDATE(5) -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fs26.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fs26.f deleted file mode 100755 index bad845d479..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3fs26.f +++ /dev/null @@ -1,87 +0,0 @@ - SUBROUTINE W3FS26(JLDAYN,IYEAR,MONTH,IDAY,IDAYWK,IDAYYR) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: W3FS26 YEAR, MONTH, DAY FROM JULIAN DAY NUMBER -C AUTHOR: JONES,R.E. ORG: W342 DATE: 87-03-29 -C -C ABSTRACT: COMPUTES YEAR (4 DIGITS), MONTH, DAY, DAY OF WEEK, DAY -C OF YEAR FROM JULIAN DAY NUMBER. THIS SUBROUTINE WILL WORK -C FROM 1583 A.D. TO 3300 A.D. -C -C PROGRAM HISTORY LOG: -C 87-03-29 R.E.JONES -C 89-10-25 R.E.JONES CONVERT TO CRAY CFT77 FORTRAN -C -C USAGE: CALL W3FS26(JLDAYN,IYEAR,MONTH,IDAY,IDAYWK,IDAYYR) -C -C INPUT VARIABLES: -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C ------ --------- ----------------------------------------------- -C JLDAYN ARG LIST INTEGER JULIAN DAY NUMBER -C -C OUTPUT VARIABLES: -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C ------ --------- ----------------------------------------------- -C IYEAR ARG LIST INTEGER YEAR (4 DIGITS) -C MONTH ARG LIST INTEGER MONTH -C IDAY ARG LIST INTEGER DAY -C IDAYWK ARG LIST INTEGER DAY OF WEEK (1 IS SUNDAY, 7 IS SAT) -C IDAYYR ARG LIST INTEGER DAY OF YEAR (1 TO 366) -C -C REMARKS: A JULIAN DAY NUMBER CAN BE COMPUTED BY USING ONE OF THE -C FOLLOWING STATEMENT FUNCTIONS. A DAY OF WEEK CAN BE COMPUTED -C FROM THE JULIAN DAY NUMBER. A DAY OF YEAR CAN BE COMPUTED FROM -C A JULIAN DAY NUMBER AND YEAR. -C -C IYEAR (4 DIGITS) -C -C JDN(IYEAR,MONTH,IDAY) = IDAY - 32075 -C & + 1461 * (IYEAR + 4800 + (MONTH - 14) / 12) / 4 -C & + 367 * (MONTH - 2 - (MONTH -14) / 12 * 12) / 12 -C & - 3 * ((IYEAR + 4900 + (MONTH - 14) / 12) / 100) / 4 -C -C IYR (4 DIGITS) , IDYR(1-366) DAY OF YEAR -C -C JULIAN(IYR,IDYR) = -31739 + 1461 * (IYR + 4799) / 4 -C & -3 * ((IYR + 4899) / 100) / 4 + IDYR -C -C DAY OF WEEK FROM JULIAN DAY NUMBER, 1 IS SUNDAY, 7 IS SATURDAY. -C -C JDAYWK(JLDAYN) = MOD((JLDAYN + 1),7) + 1 -C -C DAY OF YEAR FROM JULIAN DAY NUMBER AND 4 DIGIT YEAR. -C -C JDAYYR(JLDAYN,IYEAR) = JLDAYN - -C & (-31739+1461*(IYEAR+4799)/4-3*((IYEAR+4899)/100)/4) -C -C THE FIRST FUNCTION WAS IN A LETTER TO THE EDITOR COMMUNICATIONS -C OF THE ACM VOLUME 11 / NUMBER 10 / OCTOBER, 1968. THE 2ND -C FUNCTION WAS DERIVED FROM THE FIRST. THIS SUBROUTINE WAS ALSO -C INCLUDED IN THE SAME LETTER. JULIAN DAY NUMBER 1 IS -C JAN 1,4713 B.C. A JULIAN DAY NUMBER CAN BE USED TO REPLACE A -C DAY OF CENTURY, THIS WILL TAKE CARE OF THE DATE PROBLEM IN -C THE YEAR 2000, OR REDUCE PROGRAM CHANGES TO ONE LINE CHANGE -C OF 1900 TO 2000. JULIAN DAY NUMBERS CAN BE USED FOR FINDING -C RECORD NUMBERS IN AN ARCHIVE OR DAY OF WEEK, OR DAY OF YEAR. -C -C ATTRIBUTES: -C LANGUAGE: CRAY CFT77 FORTRAN -C MACHINE: CRAY Y-MP8/864 -C -C$$$ -C - L = JLDAYN + 68569 - N = 4 * L / 146097 - L = L - (146097 * N + 3) / 4 - I = 4000 * (L + 1) / 1461001 - L = L - 1461 * I / 4 + 31 - J = 80 * L / 2447 - IDAY = L - 2447 * J / 80 - L = J / 11 - MONTH = J + 2 - 12 * L - IYEAR = 100 * (N - 49) + I + L - IDAYWK = MOD((JLDAYN + 1),7) + 1 - IDAYYR = JLDAYN - - & (-31739 +1461 * (IYEAR+4799) / 4 - 3 * ((IYEAR+4899)/100)/4) - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3locdat.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3locdat.f deleted file mode 100755 index d88094ea86..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3locdat.f +++ /dev/null @@ -1,43 +0,0 @@ -!----------------------------------------------------------------------- - subroutine w3locdat(idat) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! -! SUBPROGRAM: W3LOCDAT RETURN THE LOCAL DATE AND TIME -! AUTHOR: MARK IREDELL ORG: WP23 DATE: 98-01-05 -! -! ABSTRACT: THIS SUBPROGRAM RETURNS THE LOCAL DATE AND TIME -! IN THE NCEP ABSOLUTE DATE AND TIME DATA STRUCTURE. -! -! PROGRAM HISTORY LOG: -! 98-01-05 MARK IREDELL -! 1999-04-28 Gilbert - added a patch to check for the proper -! UTC offset. Needed until the IBM bug -! in date_and_time is fixed. The patch -! can then be removed. See comments in -! the section blocked with "&&&&&&&&&&&". -! 1999-08-12 Gilbert - Changed so that czone variable is saved -! and the system call is only done for -! first invocation of this routine. -! -! USAGE: CALL W3LOCDAT(IDAT) -! -! OUTPUT VARIABLES: -! IDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! -! SUBPROGRAMS CALLED: -! DATE_AND_TIME FORTRAN 90 SYSTEM DATE INTRINSIC -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - integer idat(8) - character cdate*8,ctime*10,czone*5 -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! get local date and time but use the character time zone - call date_and_time(cdate,ctime,czone,idat) - read(czone,'(i5)') idat(4) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3log.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3log.f deleted file mode 100755 index fe4fa70137..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3log.f +++ /dev/null @@ -1,2 +0,0 @@ - subroutine w3log - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3movdat.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3movdat.f deleted file mode 100755 index 16cbade468..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3movdat.f +++ /dev/null @@ -1,53 +0,0 @@ -!----------------------------------------------------------------------- - subroutine w3movdat(rinc,idat,jdat) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! -! SUBPROGRAM: W3MOVDAT RETURN A DATE FROM A TIME INTERVAL AND DATE -! AUTHOR: MARK IREDELL ORG: WP23 DATE: 98-01-05 -! -! ABSTRACT: THIS SUBPROGRAM RETURNS THE DATE AND TIME THAT IS A GIVEN -! NCEP RELATIVE TIME INTERVAL FROM AN NCEP ABSOLUTE DATE AND TIME. -! THE OUTPUT IS IN THE NCEP ABSOLUTE DATE AND TIME DATA STRUCTURE. -! -! PROGRAM HISTORY LOG: -! 98-01-05 MARK IREDELL -! -! USAGE: CALL W3MOVDAT(RINC,IDAT,JDAT) -! -! INPUT VARIABLES: -! RINC REAL (5) NCEP RELATIVE TIME INTERVAL -! (DAYS, HOURS, MINUTES, SECONDS, MILLISECONDS) -! IDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! -! OUTPUT VARIABLES: -! JDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! (JDAT IS LATER THAN IDAT IF TIME INTERVAL IS POSITIVE.) -! -! SUBPROGRAMS CALLED: -! IW3JDN COMPUTE JULIAN DAY NUMBER -! W3FS26 YEAR, MONTH, DAY FROM JULIAN DAY NUMBER -! W3REDDAT REDUCE A TIME INTERVAL TO A CANONICAL FORM -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - real rinc(5) - integer idat(8),jdat(8) - real rinc1(5),rinc2(5) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! add the interval to the input time of day and put into reduced form -! and then compute new date using julian day arithmetic. - rinc1(1)=rinc(1) - rinc1(2:5)=rinc(2:5)+idat(5:8) - call w3reddat(-1,rinc1,rinc2) - jldayn=iw3jdn(idat(1),idat(2),idat(3))+nint(rinc2(1)) - call w3fs26(jldayn,jdat(1),jdat(2),jdat(3),jdow,jdoy) - jdat(4)=idat(4) - jdat(5:8)=nint(rinc2(2:5)) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3reddat.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3reddat.f deleted file mode 100755 index d15d52933e..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3reddat.f +++ /dev/null @@ -1,142 +0,0 @@ - subroutine w3reddat(it,rinc,dinc) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! -! SUBPROGRAM: W3REDDAT REDUCE A TIME INTERVAL TO A CANONICAL FORM -! AUTHOR: MARK IREDELL ORG: WP23 DATE: 98-01-05 -! -! ABSTRACT: THIS SUBPROGRAM REDUCES AN NCEP RELATIVE TIME INTERVAL -! INTO ONE OF SEVEN CANONICAL FORMS, DEPENDING ON THE INPUT IT VALUE. -! -! First reduced format type (IT=-1): -! RINC(1) is an arbitrary integer. -! RINC(2) is an integer between 00 and 23, inclusive. -! RINC(3) is an integer between 00 and 59, inclusive. -! RINC(4) is an integer between 00 and 59, inclusive. -! RINC(5) is an integer between 000 and 999, inclusive. -! If RINC(1) is negative, then the time interval is negative. -! -! Second reduced format type (IT=0): -! If the time interval is not negative, then the format is: -! RINC(1) is zero or a positive integer. -! RINC(2) is an integer between 00 and 23, inclusive. -! RINC(3) is an integer between 00 and 59, inclusive. -! RINC(4) is an integer between 00 and 59, inclusive. -! RINC(5) is an integer between 000 and 999, inclusive. -! Otherwise if the time interval is negative, then the format is: -! RINC(1) is zero or a negative integer. -! RINC(2) is an integer between 00 and -23, inclusive. -! RINC(3) is an integer between 00 and -59, inclusive. -! RINC(4) is an integer between 00 and -59, inclusive. -! RINC(5) is an integer between 000 and -999, inclusive. -! -! Days format type (IT=1): -! RINC(1) is arbitrary. -! RINC(2) is zero. -! RINC(3) is zero. -! RINC(4) is zero. -! RINC(5) is zero. -! -! Hours format type (IT=2): -! RINC(1) is zero. -! RINC(2) is arbitrary. -! RINC(3) is zero. -! RINC(4) is zero. -! RINC(5) is zero. -! (This format should not express time intervals longer than 300 years.) -! -! Minutes format type (IT=3): -! RINC(1) is zero. -! RINC(2) is zero. -! RINC(3) is arbitrary. -! RINC(4) is zero. -! RINC(5) is zero. -! (This format should not express time intervals longer than five years.) -! -! Seconds format type (IT=4): -! RINC(1) is zero. -! RINC(2) is zero. -! RINC(3) is zero. -! RINC(4) is arbitrary. -! RINC(5) is zero. -! (This format should not express time intervals longer than one month.) -! -! Milliseconds format type (IT=5): -! RINC(1) is zero. -! RINC(2) is zero. -! RINC(3) is zero. -! RINC(4) is zero. -! RINC(5) is arbitrary. -! (This format should not express time intervals longer than one hour.) -! -! PROGRAM HISTORY LOG: -! 98-01-05 MARK IREDELL -! -! USAGE: CALL W3REDDAT(IT,RINC,DINC) -! -! INPUT VARIABLES: -! IT INTEGER RELATIVE TIME INTERVAL FORMAT TYPE -! (-1 FOR FIRST REDUCED TYPE (HOURS ALWAYS POSITIVE), -! 0 FOR SECOND REDUCED TYPE (HOURS CAN BE NEGATIVE), -! 1 FOR DAYS ONLY, 2 FOR HOURS ONLY, 3 FOR MINUTES ONLY, -! 4 FOR SECONDS ONLY, 5 FOR MILLISECONDS ONLY) -! RINC REAL (5) NCEP RELATIVE TIME INTERVAL -! (DAYS, HOURS, MINUTES, SECONDS, MILLISECONDS) -! -! OUTPUT VARIABLES: -! DINC REAL (5) NCEP RELATIVE TIME INTERVAL -! (DAYS, HOURS, MINUTES, SECONDS, MILLISECONDS) -! -! SUBPROGRAMS CALLED: -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - real rinc(5),dinc(5) -! parameters for number of units in a day -! and number of milliseconds in a unit -! and number of next smaller units in a unit, respectively - integer,dimension(5),parameter:: itd=(/1,24,1440,86400,86400000/), - & itm=itd(5)/itd - integer,dimension(4),parameter:: itn=itd(2:5)/itd(1:4) - integer,parameter:: np=16 - integer iinc(4),jinc(5),kinc(5) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! first reduce to the first reduced form - iinc=floor(rinc(1:4)) -! convert all positive fractional parts to milliseconds -! and determine canonical milliseconds - jinc(5)=nint(dot_product(rinc(1:4)-iinc,real(itm(1:4)))+rinc(5)) - kinc(5)=modulo(jinc(5),itn(4)) -! convert remainder to seconds and determine canonical seconds - jinc(4)=iinc(4)+(jinc(5)-kinc(5))/itn(4) - kinc(4)=modulo(jinc(4),itn(3)) -! convert remainder to minutes and determine canonical minutes - jinc(3)=iinc(3)+(jinc(4)-kinc(4))/itn(3) - kinc(3)=modulo(jinc(3),itn(2)) -! convert remainder to hours and determine canonical hours - jinc(2)=iinc(2)+(jinc(3)-kinc(3))/itn(2) - kinc(2)=modulo(jinc(2),itn(1)) -! convert remainder to days and compute milliseconds of the day - kinc(1)=iinc(1)+(jinc(2)-kinc(2))/itn(1) - ms=dot_product(kinc(2:5),itm(2:5)) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! next reduce to either single value canonical form -! or to one of the two reduced forms - if(it.ge.1.and.it.le.5) then -! ensure that exact multiples of 1./np are expressed exactly -! (other fractions may have precision errors) - rp=(np*ms)/itm(it)+mod(np*ms,itm(it))/real(itm(it)) - dinc=0 - dinc(it)=real(kinc(1))*itd(it)+rp/np - else -! the reduced form is done except the second reduced form is modified -! for negative time intervals with fractional days - dinc=kinc - if(it.eq.0.and.kinc(1).lt.0.and.ms.gt.0) then - dinc(1)=dinc(1)+1 - dinc(2:5)=mod(ms-itm(1),itm(1:4))/itm(2:5) - endif - endif -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3tagb.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3tagb.f deleted file mode 100755 index a3d77f1a9a..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3tagb.f +++ /dev/null @@ -1,119 +0,0 @@ - SUBROUTINE W3TAGB(PROG,KYR,JD,LF,ORG) -C$$$ SUBPROGRAM DOCUMENTATION BLOCK -C -C SUBPROGRAM: W3TAGB OPERATIONAL JOB IDENTIFIER -C PRGMMR: FARLEY ORG: NP11 DATE: 1998-03-17 -C -C ABSTRACT: PRINTS IDENTIFYING INFORMATION FOR OPERATIONAL -C codes. CALLED AT THE BEGINNING OF A code, W3TAGB PRINTS -C THE program NAME, THE YEAR AND JULIAN DAY OF ITS -C COMPILATION, AND THE RESPONSIBLE ORGANIZATION. ON A 2ND -C LINE IT PRINTS THE STARTING DATE-TIME. CALLED AT THE -C END OF A JOB, entry routine, W3TAGE PRINTS A LINE WITH THE -C ENDING DATE-TIME AND A 2ND LINE STATING THE program name -C AND THAT IT HAS ENDED. -C -C PROGRAM HISTORY LOG: -C 85-10-29 J.NEWELL -C 89-10-20 R.E.JONES CONVERT TO CRAY CFT77 FORTRAN -C 91-03-01 R.E.JONES ADD MACHINE NAME TO ENDING LINE -C 92-12-02 R.E.JONES ADD START-ENDING TIME-DATE -C 93-11-16 R.E.JONES ADD DAY OF YEAR, DAY OF WEEK, AND JULIAN DAY -C NUMBER. -C 97-12-24 M.FARLEY PRINT STATEMENTS MODIFIED FOR 4-DIGIT YR -C 98-03-17 M.FARLEY REPLACED DATIMX WITH CALLS TO W3LOCDAT/W3DOXDAT -C 99-01-29 B. VUONG CONVERTED TO IBM RS/6000 SP -C -C 99-06-17 A. Spruill ADJUSTED THE SIZE OF PROGRAM NAME TO ACCOMMODATE -C THE 20 CHARACTER NAME CONVENTION ON THE IBM SP. -C 1999-08-24 Gilbert added call to START() in W3TAGB and a call -C to SUMMARY() in W3TAGE to print out a -C resource summary list for the program using -C W3TAGs. -C -C USAGE: CALL W3TAGB(PROG, KYR, JD, LF, ORG) -C CALL W3TAGE(PROG) -C -C INPUT VARIABLES: -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C ------ --------- ----------------------------------------------- -C PROG ARG LIST PROGRAM NAME CHARACTER*1 -C KYR ARG LIST YEAR OF COMPILATION INTEGER -C JD ARG LIST JULIAN DAY OF COMPILATION INTEGER -C LF ARG LIST HUNDRETHS OF JULIAN DAY OF COMPILATION -C INTEGER (RANGE IS 0 TO 99 INCLUSIVE) -C ORG ARG LIST ORGANIZATION CODE (SUCH AS WD42) -C CHARACTER*1 -C -C OUTPUT VARIABLES: -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C ---------------------------------------------------------------- -C DDATE PRINT YEAR AND JULIAN DAY (NEAREST HUNDRETH) -C FILE OF COMPILATION REAL -C -C SUBPROGRAMS CALLED: CLOCK, DATE -C -C REMARKS: FULL WORD USED IN ORDER TO HAVE AT LEAST -C SEVEN DECIMAL DIGITS ACCURACY FOR VALUE OF DDATE. -C SUBPROGRAM CLOCK AND DATE MAY DIFFER FOR EACH TYPE -C COMPUTER. YOU MAY HAVE TO CHANGE THEM FOR ANOTHER -C TYPE OF COMPUTER. -C -C ATTRIBUTES: -C LANGUAGE: FORTRAN 90 -C -C$$$ -C - CHARACTER *(*) PROG,ORG - CHARACTER * 3 JMON(12) - CHARACTER * 3 DAYW(7) -C - INTEGER IDAT(8), JDOW, JDOY, JDAY -C - SAVE -C - DATA DAYW/'SUN','MON','TUE','WEN','THU','FRI','SAT'/ - DATA JMON /'JAN','FEB','MAR','APR','MAY','JUN', - & 'JUL','AUG','SEP','OCT','NOV','DEC'/ -C - CALL START() - - DYR = KYR - DYR = 1.0E+03 * DYR - DJD = JD - DLF = LF - DLF = 1.0E-02 * DLF - DDATE = DYR + DJD + DLF - PRINT 600 - 600 FORMAT(//,10('* . * . ')) - PRINT 601, PROG, DDATE, ORG - 601 FORMAT(5X,'PROGRAM ',A,' HAS BEGUN. COMPILED ',F10.2, - & 5X, 'ORG: ',A) -C - CALL W3LOCDAT(IDAT) - CALL W3DOXDAT(IDAT,JDOW,JDOY,JDAY) - PRINT 602, JMON(IDAT(2)),IDAT(3),IDAT(1),IDAT(5),IDAT(6), - & IDAT(7),IDAT(8),JDOY,DAYW(JDOW),JDAY - 602 FORMAT(5X,'STARTING DATE-TIME ',A3,1X,I2.2,',', - & I4.4,2X,2(I2.2,':'),I2.2,'.',I3.3,2X,I3,2X,A3,2X,I8,//) - RETURN -C - ENTRY W3TAGE(PROG) -C - CALL W3LOCDAT(IDAT) - CALL W3DOXDAT(IDAT,JDOW,JDOY,JDAY) - PRINT 603, JMON(IDAT(2)),IDAT(3),IDAT(1),IDAT(5),IDAT(6), - & IDAT(7),IDAT(8),JDOY,DAYW(JDOW),JDAY - 603 FORMAT(//,5X,'ENDING DATE-TIME ',A3,1X,I2.2,',', - & I4.4,2X,2(I2.2,':'),I2.2,'.',I3.3,2X,I3,2X,A3,2X,I8) - PRINT 604, PROG - 604 FORMAT(5X,'PROGRAM ',A,' HAS ENDED. IBM RS/6000 SP') -C 604 FORMAT(5X,'PROGRAM ',A,' HAS ENDED. CRAY J916/2048') -C 604 FORMAT(5X,'PROGRAM ',A,' HAS ENDED. CRAY Y-MP EL2/256') - PRINT 605 - 605 FORMAT(10('* . * . ')) - - CALL SUMMARY() -C - RETURN - END diff --git a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3utcdat.f b/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3utcdat.f deleted file mode 100755 index 600f573b82..0000000000 --- a/nativeLib/ncep_grib2module/dependencies/src/w3lib-1.6/w3utcdat.f +++ /dev/null @@ -1,67 +0,0 @@ -!----------------------------------------------------------------------- - subroutine w3utcdat(idat) -!$$$ SUBPROGRAM DOCUMENTATION BLOCK -! -! SUBPROGRAM: W3UTCDAT RETURN THE UTC DATE AND TIME -! AUTHOR: MARK IREDELL ORG: WP23 DATE: 98-01-05 -! -! ABSTRACT: THIS SUBPROGRAM RETURNS THE UTC (GREENWICH) DATE AND TIME -! IN THE NCEP ABSOLUTE DATE AND TIME DATA STRUCTURE. -! -! PROGRAM HISTORY LOG: -! 98-01-05 MARK IREDELL -! 1999-04-28 Gilbert - added a patch to check for the proper -! UTC offset. Needed until the IBM bug -! in date_and_time is fixed. The patch -! can then be removed. See comments in -! the section blocked with "&&&&&&&&&&&". -! 1999-08-12 Gilbert - Changed so that czone variable is saved -! and the system call is only done for -! first invocation of this routine. -! -! USAGE: CALL W3UTCDAT(IDAT) -! -! OUTPUT VARIABLES: -! IDAT INTEGER (8) NCEP ABSOLUTE DATE AND TIME -! (YEAR, MONTH, DAY, TIME ZONE, -! HOUR, MINUTE, SECOND, MILLISECOND) -! -! SUBPROGRAMS CALLED: -! DATE_AND_TIME FORTRAN 90 SYSTEM DATE INTRINSIC -! IW3JDN COMPUTE JULIAN DAY NUMBER -! W3FS26 YEAR, MONTH, DAY FROM JULIAN DAY NUMBER -! -! ATTRIBUTES: -! LANGUAGE: FORTRAN 90 -! -!$$$ - integer idat(8) - character cdate*8,ctime*10,czone*5 -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! get local date and time but use the character time zone - call date_and_time(cdate,ctime,czone,idat) - read(czone,'(i5)') idat(4) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! convert to hours and minutes to UTC time -! and possibly adjust the date as well - idat(6)=idat(6)-mod(idat(4),100) - idat(5)=idat(5)-idat(4)/100 - idat(4)=0 - if(idat(6).lt.00) then - idat(6)=idat(6)+60 - idat(5)=idat(5)-1 - elseif(idat(6).ge.60) then - idat(6)=idat(6)-60 - idat(5)=idat(5)+1 - endif - if(idat(5).lt.00) then - idat(5)=idat(5)+24 - jldayn=iw3jdn(idat(1),idat(2),idat(3))-1 - call w3fs26(jldayn,idat(1),idat(2),idat(3),idaywk,idayyr) - elseif(idat(5).ge.24) then - idat(5)=idat(5)-24 - jldayn=iw3jdn(idat(1),idat(2),idat(3))+1 - call w3fs26(jldayn,idat(1),idat(2),idat(3),idaywk,idayyr) - endif -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end diff --git a/nativeLib/rary.cots.g2clib/.cproject b/nativeLib/rary.cots.g2clib/.cproject new file mode 100644 index 0000000000..7fc0ae25fe --- /dev/null +++ b/nativeLib/rary.cots.g2clib/.cproject @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.cots.g2clib/.project b/nativeLib/rary.cots.g2clib/.project new file mode 100644 index 0000000000..c6deea5219 --- /dev/null +++ b/nativeLib/rary.cots.g2clib/.project @@ -0,0 +1,80 @@ + + + rary.cots.g2clib + + + rary.cots.jasper + + + + org.eclipse.cdt.managedbuilder.core.genmakebuilder + clean,full,incremental, + + + ?name? + + + + org.eclipse.cdt.make.core.append_environment + true + + + org.eclipse.cdt.make.core.autoBuildTarget + all + + + org.eclipse.cdt.make.core.buildArguments + + + + org.eclipse.cdt.make.core.buildCommand + make + + + org.eclipse.cdt.make.core.cleanBuildTarget + clean + + + org.eclipse.cdt.make.core.contents + org.eclipse.cdt.make.core.activeConfigSettings + + + org.eclipse.cdt.make.core.enableAutoBuild + false + + + org.eclipse.cdt.make.core.enableCleanBuild + true + + + org.eclipse.cdt.make.core.enableFullBuild + true + + + org.eclipse.cdt.make.core.fullBuildTarget + all + + + org.eclipse.cdt.make.core.stopOnError + true + + + org.eclipse.cdt.make.core.useDefaultBuildCmd + true + + + + + org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder + full,incremental, + + + + + + org.eclipse.cdt.core.cnature + org.eclipse.cdt.core.ccnature + org.eclipse.cdt.managedbuilder.core.managedBuildNature + org.eclipse.cdt.managedbuilder.core.ScannerConfigNature + + diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/CHANGES b/nativeLib/rary.cots.g2clib/CHANGES similarity index 75% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/CHANGES rename to nativeLib/rary.cots.g2clib/CHANGES index 15cf4e902d..b5edbb469a 100644 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/CHANGES +++ b/nativeLib/rary.cots.g2clib/CHANGES @@ -45,3 +45,20 @@ g2libc-1.1.8 - January 2009 - Initialize variable lencsec2 in routine g2_unpack - Changed the structure name template to gtemplate to avoid of reserved word in C++ - Change routine seekgb.c to use 4 bytes instead of sizeof(g2int) + +g2libc-1.1.9 - June 2009 - Updated version jasper-1.900.1, libpng-1.2.35 and zlib-1.2.3 + - Fixed bug causing seg fault when using PNG 1.2.35 + +g2libc-1.2.0 - March 2010 - Added PDT 4.31 Satellite Product + - Added PDT 4.15 WAFS Product + +g2libc-1.2.1 - August 2010 - Added PDT 4.40,4.41,4.42,4.43 for Atmospheric Chemical Constituents + - Added GDT 3.32769 Rot Lat/Lon None E-grid (Arakawa) + - If section 2 has zero length, return IERR=0 + +g2libc-1.2.2 - March 2011 - Corrected PDT 4.42,4.43 for Atmospheric Chemical Constituents + +g2libc-1.2.3 - November 2011 - Fixed bugs in routines dec_png.c and enc_png.c + +g2libc-1.4.0 - May 2012 - Added PDT 4.44,4.45,4.46,4.47,4.48 for Aerosol products + - PDT 4.50,4.51,4.52 iand 4.91 for Categorical forecast at a horizonal diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/README b/nativeLib/rary.cots.g2clib/README similarity index 85% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/README rename to nativeLib/rary.cots.g2clib/README index 012c3dca6b..d9a7bbc7a2 100644 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/README +++ b/nativeLib/rary.cots.g2clib/README @@ -1,5 +1,5 @@ - Sep 04, 2008 - + JUNE 01, 2009 + W/NP11:SAG g2clib Library. @@ -37,8 +37,8 @@ libjasper.a - This library is a C implementation of the JPEG-2000 Part-1 the -DUSE_JPEG2000 option from the DEFS variable in the makefile. - Download version jasper-1.700.2 from the link belows: - http://www.nco.ncep.noaa.gov/pmb/codes/GRIB2/ + Download version jasper-1.900.1 from the JasPer Project's + home page, http://www.ece.uvic.ca/~mdadams/jasper/. More information about JPEG2000 can be found at http://www.jpeg.org/JPEG2000.html. @@ -50,7 +50,7 @@ libpng.a This library is a C implementation of the Portable Network in the makefile. If not already installed on your system, download version - libpng-1.2.5 from http://www.libpng.org/pub/png/libpng.html. + libpng-1.2.35 from http://www.libpng.org/pub/png/libpng.html. More information about PNG can be found at http://www.libpng.org/pub/png/. @@ -62,6 +62,6 @@ libz.a This library contains compression/decompression routines in g2lib/makefile. If not already installed on your system, download version - zlib-1.1.4 from http://www.gzip.org/zlib/. + zlib-1.2.3 from http://www.gzip.org/zlib/. diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/cmplxpack.c b/nativeLib/rary.cots.g2clib/cmplxpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/cmplxpack.c rename to nativeLib/rary.cots.g2clib/cmplxpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/compack.c b/nativeLib/rary.cots.g2clib/compack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/compack.c rename to nativeLib/rary.cots.g2clib/compack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/comunpack.c b/nativeLib/rary.cots.g2clib/comunpack.c similarity index 93% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/comunpack.c rename to nativeLib/rary.cots.g2clib/comunpack.c index ee650ef30f..1a0b0e0091 100755 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/comunpack.c +++ b/nativeLib/rary.cots.g2clib/comunpack.c @@ -108,17 +108,23 @@ int comunpack(unsigned char *cpack,g2int lensec,g2int idrsnum,g2int *idrstmpl,g2 // if (idrsnum == 3) { if (nbitsd != 0) { - gbit(cpack,&isign,iofst,1); - iofst=iofst+1; - gbit(cpack,&ival1,iofst,nbitsd-1); - iofst=iofst+nbitsd-1; - if (isign == 1) ival1=-ival1; +// wne mistake here shoujld be unsigned int + gbit(cpack,&ival1,iofst,nbitsd); + iofst=iofst+nbitsd; +// gbit(cpack,&isign,iofst,1); +// iofst=iofst+1; +// gbit(cpack,&ival1,iofst,nbitsd-1); +// iofst=iofst+nbitsd-1; +// if (isign == 1) ival1=-ival1; if (idrstmpl[16] == 2) { - gbit(cpack,&isign,iofst,1); - iofst=iofst+1; - gbit(cpack,&ival2,iofst,nbitsd-1); - iofst=iofst+nbitsd-1; - if (isign == 1) ival2=-ival2; +// wne mistake here shoujld be unsigned int + gbit(cpack,&ival2,iofst,nbitsd); + iofst=iofst+nbitsd; +// gbit(cpack,&isign,iofst,1); +// iofst=iofst+1; +// gbit(cpack,&ival2,iofst,nbitsd-1); +// iofst=iofst+nbitsd-1; +// if (isign == 1) ival2=-ival2; } gbit(cpack,&isign,iofst,1); iofst=iofst+1; @@ -224,7 +230,7 @@ int comunpack(unsigned char *cpack,g2int lensec,g2int idrsnum,g2int *idrstmpl,g2 // missing values included ifldmiss=(g2int *)malloc(ndpts*sizeof(g2int)); //printf("ALLOC ifldmiss: %d %x\n",(int)ndpts,ifldmiss); - //for (j=0;jwidth,info_ptr->height,info_ptr->bit_depth);*/ - (void)png_get_IHDR(png_ptr, info_ptr, (png_uint_32 *)width, (png_uint_32 *)height, + // (void)png_get_IHDR(png_ptr, info_ptr, (png_uint_32 *)width, (png_uint_32 *)height, + (void)png_get_IHDR(png_ptr, info_ptr, &w32, &h32, &bit_depth, &color, &interlace, &compres, &filter); + *height = h32; + *width = w32; + /* Check if image was grayscale */ /* diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/drstemplates.c b/nativeLib/rary.cots.g2clib/drstemplates.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/drstemplates.c rename to nativeLib/rary.cots.g2clib/drstemplates.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/drstemplates.h b/nativeLib/rary.cots.g2clib/drstemplates.h similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/drstemplates.h rename to nativeLib/rary.cots.g2clib/drstemplates.h diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/enc_jpeg2000.c b/nativeLib/rary.cots.g2clib/enc_jpeg2000.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/enc_jpeg2000.c rename to nativeLib/rary.cots.g2clib/enc_jpeg2000.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/enc_png.c b/nativeLib/rary.cots.g2clib/enc_png.c similarity index 97% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/enc_png.c rename to nativeLib/rary.cots.g2clib/enc_png.c index 3f05f16881..c3f75bd4c5 100644 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/enc_png.c +++ b/nativeLib/rary.cots.g2clib/enc_png.c @@ -88,7 +88,7 @@ int enc_png(char *data,g2int width,g2int height,g2int nbits,char *pngbuf) /* Set new custom write functions */ - png_set_write_fn(png_ptr,(voidp)&write_io_ptr,(png_rw_ptr)user_write_data, + png_set_write_fn(png_ptr,(png_voidp)&write_io_ptr,(png_rw_ptr)user_write_data, (png_flush_ptr)user_flush_data); /* png_init_io(png_ptr, fptr); */ /* png_set_compression_level(png_ptr, Z_BEST_COMPRESSION); */ diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_addfield.c b/nativeLib/rary.cots.g2clib/g2_addfield.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_addfield.c rename to nativeLib/rary.cots.g2clib/g2_addfield.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_addgrid.c b/nativeLib/rary.cots.g2clib/g2_addgrid.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_addgrid.c rename to nativeLib/rary.cots.g2clib/g2_addgrid.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_addlocal.c b/nativeLib/rary.cots.g2clib/g2_addlocal.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_addlocal.c rename to nativeLib/rary.cots.g2clib/g2_addlocal.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_create.c b/nativeLib/rary.cots.g2clib/g2_create.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_create.c rename to nativeLib/rary.cots.g2clib/g2_create.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_free.c b/nativeLib/rary.cots.g2clib/g2_free.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_free.c rename to nativeLib/rary.cots.g2clib/g2_free.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_getfld.c b/nativeLib/rary.cots.g2clib/g2_getfld.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_getfld.c rename to nativeLib/rary.cots.g2clib/g2_getfld.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_gribend.c b/nativeLib/rary.cots.g2clib/g2_gribend.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_gribend.c rename to nativeLib/rary.cots.g2clib/g2_gribend.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_info.c b/nativeLib/rary.cots.g2clib/g2_info.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_info.c rename to nativeLib/rary.cots.g2clib/g2_info.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_miss.c b/nativeLib/rary.cots.g2clib/g2_miss.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_miss.c rename to nativeLib/rary.cots.g2clib/g2_miss.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack1.c b/nativeLib/rary.cots.g2clib/g2_unpack1.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack1.c rename to nativeLib/rary.cots.g2clib/g2_unpack1.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack2.c b/nativeLib/rary.cots.g2clib/g2_unpack2.c similarity index 94% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack2.c rename to nativeLib/rary.cots.g2clib/g2_unpack2.c index 1679e9873a..08d9ef5925 100755 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack2.c +++ b/nativeLib/rary.cots.g2clib/g2_unpack2.c @@ -14,6 +14,7 @@ g2int g2_unpack2(unsigned char *cgrib,g2int *iofst,g2int *lencsec2,unsigned char // PROGRAM HISTORY LOG: // 2002-10-31 Gilbert // 2008-12-23 Wesley - Initialize lencsec2 Length of Local Use data +// 2010-08-05 Vuong - If section 2 has zero length, ierr=0 // // USAGE: int g2_unpack2(unsigned char *cgrib,g2int *iofst,g2int *lencsec2, // unsigned char **csec2) @@ -62,6 +63,11 @@ g2int g2_unpack2(unsigned char *cgrib,g2int *iofst,g2int *lencsec2,unsigned char return(ierr); } + if (*lencsec2 == 0) { + ierr = 0; + return(ierr); + } + *csec2=(unsigned char *)malloc(*lencsec2+1); if (*csec2 == 0) { ierr=6; diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack3.c b/nativeLib/rary.cots.g2clib/g2_unpack3.c similarity index 99% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack3.c rename to nativeLib/rary.cots.g2clib/g2_unpack3.c index 5d5cbf8eef..147a002cd9 100644 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack3.c +++ b/nativeLib/rary.cots.g2clib/g2_unpack3.c @@ -212,5 +212,6 @@ g2int g2_unpack3(unsigned char *cgrib,g2int *iofst,g2int **igds,g2int **igdstmpl *idefnum=0; *ideflist=0; // NULL } + return(ierr); // End of Section 3 processing } diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack4.c b/nativeLib/rary.cots.g2clib/g2_unpack4.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack4.c rename to nativeLib/rary.cots.g2clib/g2_unpack4.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack5.c b/nativeLib/rary.cots.g2clib/g2_unpack5.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack5.c rename to nativeLib/rary.cots.g2clib/g2_unpack5.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack6.c b/nativeLib/rary.cots.g2clib/g2_unpack6.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack6.c rename to nativeLib/rary.cots.g2clib/g2_unpack6.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack7.c b/nativeLib/rary.cots.g2clib/g2_unpack7.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/g2_unpack7.c rename to nativeLib/rary.cots.g2clib/g2_unpack7.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gbits.c b/nativeLib/rary.cots.g2clib/gbits.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gbits.c rename to nativeLib/rary.cots.g2clib/gbits.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/getdim.c b/nativeLib/rary.cots.g2clib/getdim.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/getdim.c rename to nativeLib/rary.cots.g2clib/getdim.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/getpoly.c b/nativeLib/rary.cots.g2clib/getpoly.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/getpoly.c rename to nativeLib/rary.cots.g2clib/getpoly.c diff --git a/nativeLib/ncep_grib2module/dependencies/include/grib2.h b/nativeLib/rary.cots.g2clib/grib2.h similarity index 99% rename from nativeLib/ncep_grib2module/dependencies/include/grib2.h rename to nativeLib/rary.cots.g2clib/grib2.h index 77f4d2e4e2..f717831007 100755 --- a/nativeLib/ncep_grib2module/dependencies/include/grib2.h +++ b/nativeLib/rary.cots.g2clib/grib2.h @@ -2,7 +2,7 @@ #define _grib2_H #include -#define G2_VERSION "g2clib-1.1.8" +#define G2_VERSION "g2clib-1.4.0" /* . . . . // PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-10-25 // diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/grib2c.doc b/nativeLib/rary.cots.g2clib/grib2c.doc similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/grib2c.doc rename to nativeLib/rary.cots.g2clib/grib2c.doc diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gridtemplates.c b/nativeLib/rary.cots.g2clib/gridtemplates.c similarity index 95% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gridtemplates.c rename to nativeLib/rary.cots.g2clib/gridtemplates.c index 0931492387..6447a5b98a 100755 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gridtemplates.c +++ b/nativeLib/rary.cots.g2clib/gridtemplates.c @@ -16,6 +16,7 @@ g2int getgridindex(g2int number) ! 2007-08-16 Vuong - Added GDT 3.204 Curvilinear Orthogonal Grid ! 2008-07-08 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid (Arakawa) ! 2009-01-14 Vuong - Changed structure name template to gtemplate +! 2010-05-11 Vuong - Added GDT 3.32769 Rotate Lat/Lon Non-E Staggered grid (Arakawa) ! ! USAGE: index=getgridindex(number) ! INPUT ARGUMENT LIST: @@ -61,6 +62,7 @@ gtemplate *getgridtemplate(g2int number) ! 2000-05-09 Gilbert ! 2007-08-16 Vuong - Added GDT 3.204 Curvilinear Orthogonal Grid ! 2008-07-08 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid (Arakawa) +! 2010-05-11 Vuong - Added GDT 3.32769 Rotate Lat/Lon Non-E Staggered grid (Arakawa) ! 2009-01-14 Vuong - Changed structure name template to gtemplate ! ! USAGE: gtemplate *getgridtemplate(number) @@ -121,6 +123,7 @@ gtemplate *extgridtemplate(g2int number,g2int *list) ! 2000-05-09 Gilbert ! 2008-07-08 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid (Arakawa) ! 2009-01-14 Vuong - Changed structure name template to gtemplate +! 2010-05-11 Vuong - Added GDT 3.32769 Rotate Lat/Lon Non-E Staggered grid (Arakawa) ! ! USAGE: CALL extgridtemplate(number,list) ! INPUT ARGUMENT LIST: diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gridtemplates.h b/nativeLib/rary.cots.g2clib/gridtemplates.h similarity index 94% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gridtemplates.h rename to nativeLib/rary.cots.g2clib/gridtemplates.h index 2e19f7645d..166ea3d48f 100755 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/gridtemplates.h +++ b/nativeLib/rary.cots.g2clib/gridtemplates.h @@ -33,10 +33,11 @@ // 2001-10-26 Gilbert // 2007-08-16 Vuong - Added GDT 3.204 Curvilinear Orthogonal Grid // 2008-07-08 Vuong - Added GDT 3.32768 Rot Lat/Lon E-grid (Arakawa) +// 2010-05-11 Vuong - Added GDT 3.32769 Rotate Lat/Lon Non-E Staggered grid (Arakawa) // //////////////////////////////////////////////////////////////////// - #define MAXGRIDTEMP 25 // maximum number of templates + #define MAXGRIDTEMP 26 // maximum number of templates #define MAXGRIDMAPLEN 200 // maximum template map length struct gridtemplate @@ -92,6 +93,8 @@ {204, 19, 0, {1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1} }, // 3.32768: Rot Lat/Lon E-grid (Arakawa) {32768, 19, 0, {1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1} }, + // 3.32769: Rot Lat/Lon Non-E Staggered grid (Arakawa) + {32769, 21, 0, {1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,4,4} }, // 3.1000: Cross Section Grid {1000, 20, 1, {1,1,4,1,4,1,4,4,4,4,-4,4,1,4,4,1,2,1,1,2} }, // 3.1100: Hovmoller Diagram Grid diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/int_power.c b/nativeLib/rary.cots.g2clib/int_power.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/int_power.c rename to nativeLib/rary.cots.g2clib/int_power.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/jpcpack.c b/nativeLib/rary.cots.g2clib/jpcpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/jpcpack.c rename to nativeLib/rary.cots.g2clib/jpcpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/jpcunpack.c b/nativeLib/rary.cots.g2clib/jpcunpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/jpcunpack.c rename to nativeLib/rary.cots.g2clib/jpcunpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/main.c b/nativeLib/rary.cots.g2clib/main.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/main.c rename to nativeLib/rary.cots.g2clib/main.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/mainhome.c b/nativeLib/rary.cots.g2clib/mainhome.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/mainhome.c rename to nativeLib/rary.cots.g2clib/mainhome.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/makefile b/nativeLib/rary.cots.g2clib/makefile old mode 100644 new mode 100755 similarity index 76% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/makefile rename to nativeLib/rary.cots.g2clib/makefile index 2f5398c352..56fe7b91d5 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/makefile +++ b/nativeLib/rary.cots.g2clib/makefile @@ -11,25 +11,29 @@ SHELL=/bin/sh # In addition, INC must include all directories where the above # mentioned include files can be found. DEFS=-DUSE_JPEG2000 -DUSE_PNG -INC=-I../../include \ - -I../../../../rary.cots.jasper/jasper-1.900.1/src/libjasper/include + +# +# Please make sure to include all idirectories where include files +# can be found (jasper/*.h and png.h pngconf.h zconf.h zlib.h) +# + +INC=-I../rary.cots.jasper/jasper-1.900.1/src/libjasper/include # # This "C" source code contains many uses of the C++ # comment style "//". Please make sure you include the # appropriate compiler flag to allow the use of "//" comment indicators. # -#CFLAGS=-q64 -O3 -qarch=auto -qcpluscmt $(INC) $(DEFS) -CFLAGS = $(INC) $(DEFS) -O3 -fPIC --include ../../../../build.native/makefile.arch +CFLAGS= $(INC) $(DEFS) -O3 -fPIC +-include ../build.native/makefile.arch ifeq ($(ARCHFLAGS),-m64) export CFLAGS := $(CFLAGS) -D__64BIT__ endif CC=gcc + LIB=libgrib2c.a -#ARFLAGS=-X64 -ARFLAGS=ruc +ARFLAGS= all: $(LIB) @@ -83,23 +87,12 @@ $(LIB): $(LIB)(gridtemplates.o) \ $(LIB)(g2_miss.o) \ $(LIB)(getpoly.o) \ $(LIB)(seekgb.o) -# $(LIB)(getfield.o) \ -# $(LIB)(gettemplates.o) \ -# $(LIB)(getlocal.o) \ -# $(LIB)(gribinfo.o) \ -# $(LIB)(ixgb2.o) \ -# $(LIB)(getg2i.o) \ -# $(LIB)(getg2ir.o) \ -# $(LIB)(getgb2s.o) \ -# $(LIB)(getgb2r.o) \ -# $(LIB)(getgb2l.o) \ -# $(LIB)(getgb2.o) \ -# $(LIB)(putgb2.o) \ -# $(LIB)(params.o) .c.a: $(CC) -c $(CFLAGS) $< - ar $(ARFLAGS) $@ $*.o + ar $(ARFLAGS) -ruv $@ $*.o + rm -f $*.o + +clean: + rm -f libgrib2c.a - gcc $(CFLAGS) -shared -o g2clib1.1.8.so *.o - rm *.o diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/misspack.c b/nativeLib/rary.cots.g2clib/misspack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/misspack.c rename to nativeLib/rary.cots.g2clib/misspack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/mkieee.c b/nativeLib/rary.cots.g2clib/mkieee.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/mkieee.c rename to nativeLib/rary.cots.g2clib/mkieee.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pack_gp.c b/nativeLib/rary.cots.g2clib/pack_gp.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pack_gp.c rename to nativeLib/rary.cots.g2clib/pack_gp.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pdstemplates.c b/nativeLib/rary.cots.g2clib/pdstemplates.c similarity index 62% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pdstemplates.c rename to nativeLib/rary.cots.g2clib/pdstemplates.c index caf4b0b4f1..7cc93dc3e9 100755 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pdstemplates.c +++ b/nativeLib/rary.cots.g2clib/pdstemplates.c @@ -14,6 +14,12 @@ g2int getpdsindex(g2int number) // PROGRAM HISTORY LOG: // 2001-06-28 Gilbert // 2009-01-14 Vuong Changed structure name template to gtemplate +// 2009-12-15 Vuong Added Product Definition Template 4.31 +// Added Product Definition Template 4.15 +// 2010-08-03 Vuong Added Product Definition Template 4.42 and 4.43 +// 2010-12-08 Vuong Corrected Product Definition Template 4.42 and 4.43 +// 2012-03-29 Vuong Added Templates 4.44,4.45,4.46,4.47,4.48,4.50, +// 4.51,4.91,4.32 and 4.52 // // USAGE: index=getpdsindex(number) // INPUT ARGUMENT LIST: @@ -59,6 +65,11 @@ gtemplate *getpdstemplate(g2int number) // PROGRAM HISTORY LOG: // 2000-05-11 Gilbert // 2009-01-14 Vuong Changed structure name template to gtemplate +// 2009-08-05 Vuong Added Product Definition Template 4.31 +// 2010-08-03 Vuong Added Product Definition Template 4.42 and 4.43 +// 2010-12-08 Vuong Corrected Product Definition Template 4.42 and 4.43 +// 2012-02-15 Vuong Added Templates 4.44,4.45,4.46,4.47,4.48,4.50, +// 4.51,4.91,4.32 and 4.52 // // USAGE: CALL getpdstemplate(number) // INPUT ARGUMENT LIST: @@ -117,6 +128,11 @@ gtemplate *extpdstemplate(g2int number,g2int *list) // PROGRAM HISTORY LOG: // 2000-05-11 Gilbert // 2009-01-14 Vuong Changed structure name template to gtemplate +// 2009-08-05 Vuong Added Product Definition Template 4.31 +// 2010-08-03 Vuong Added Product Definition Template 4.42 and 4.43 +// 2010-12-08 Vuong Corrected Product Definition Template 4.42 and 4.43 +// 2012-02-15 Vuong Added Templates 4.44,4.45,4.46,4.47,4.48,4.50, +// 4.51,4.91,4.32 and 4.52 // // USAGE: CALL extpdstemplate(number,list) // INPUT ARGUMENT LIST: @@ -265,7 +281,128 @@ gtemplate *extpdstemplate(g2int number,g2int *list) new->ext[l+4]=4; } } + else if ( number == 31 ) { + new->extlen=list[4]*5; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (i=0;iext[l]=2; + new->ext[l+1]=2; + new->ext[l+2]=2; + new->ext[l+3]=1; + new->ext[l+4]=4; + } + } + else if ( number == 42 ) { + if ( list[22] > 1 ) { + new->extlen=(list[22]-1)*6; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (j=2;j<=list[22];j++) { + l=(j-2)*6; + for (k=0;k<6;k++) { + new->ext[l+k]=new->map[24+k]; + } + } + } + } + else if ( number == 43 ) { + if ( list[25] > 1 ) { + new->extlen=(list[25]-1)*6; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (j=2;j<=list[25];j++) { + l=(j-2)*6; + for (k=0;k<6;k++) { + new->ext[l+k]=new->map[27+k]; + } + } + } + } + else if ( number == 32 ) { + new->extlen=list[9]*10; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (i=0;iext[l]=2; + new->ext[l+1]=2; + new->ext[l+2]=2; + new->ext[l+3]=1; + new->ext[l+4]=4; + } + } + else if ( number == 46 ) { + if ( list[27] > 1 ) { + new->extlen=(list[27]-1)*6; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (j=2;j<=list[27];j++) { + l=(j-2)*6; + for (k=0;k<6;k++) { + new->ext[l+k]=new->map[29+k]; + } + } + } + } + else if ( number == 47 ) { + if ( list[30] > 1 ) { + new->extlen=(list[30]-1)*6; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (j=2;j<=list[30];j++) { + l=(j-2)*6; + for (k=0;k<6;k++) { + new->ext[l+k]=new->map[32+k]; + } + } + } + else if ( number == 51 ) { + new->extlen=list[15]*11; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (i=0;iext[l]=1; + new->ext[l+1]=1; + new->ext[l+2]=-1; + new->ext[l+3]=-4; + new->ext[l+4]=-1; + new->ext[l+5]=-4; + } + } + else if ( number == 91 ) { + new->extlen=list[15]*11; + new->ext=(g2int *)malloc(sizeof(g2int)*new->extlen); + for (i=0;iext[l]=1; + new->ext[l+1]=1; + new->ext[l+2]=-1; + new->ext[l+3]=-4; + new->ext[l+4]=-1; + new->ext[l+5]=-4; + new->ext[l+6]=2; + new->ext[l+7]=1; + new->ext[l+8]=1; + new->ext[l+9]=1; + new->ext[l+10]=1; + new->ext[l+11]=1; + new->ext[l+12]=1; + } + if ( list[28] = 1 ) { + new->ext[l]=1; + new->ext[l+1]=1; + new->ext[l+2]=1; + new->ext[l+3]=4; + new->ext[l+4]=1; + new->ext[l+5]=4; + } + else if ( list[28] > 1 ) { + new->ext[l]=1; + new->ext[l+1]=1; + new->ext[l+2]=1; + new->ext[l+3]=4; + new->ext[l+4]=1; + new->ext[l+5]=4; + } + } + } + return(new); } - diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pdstemplates.h b/nativeLib/rary.cots.g2clib/pdstemplates.h similarity index 56% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pdstemplates.h rename to nativeLib/rary.cots.g2clib/pdstemplates.h index 2dbe01271a..9de9699b2f 100755 --- a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pdstemplates.h +++ b/nativeLib/rary.cots.g2clib/pdstemplates.h @@ -28,12 +28,19 @@ // in this case would be the absolute value of the negative value in // mappds[]. // -// 2005-12-08 Gilbert - Allow negative scale factors and limits for -// Templates 4.5 and 4.9 +// 2005-12-08 Gilbert Allow negative scale factors and limits for +// Templates 4.5 and 4.9 +// 2009-12-15 Vuong Added Product Definition Template 4.31 +// Added Product Definition Template 4.15 +// 2010-08-03 Vuong Added Product Definition Template 4.40,4.41,4.42,4.43 +// 2010-12-08 Vuong Corrected Definition Template 4.42,4.43 +// 2010-12-08 Vuong Corrected Definition Template 4.42,4.43 +// 2012-03-29 Vuong Added Templates 4.44,4.45,4.46,4.47,4.48,4.50, +// 4.51,4.91,4.32 and 4.52 // //$$$ - #define MAXPDSTEMP 23 // maximum number of templates + #define MAXPDSTEMP 39 // maximum number of templates #define MAXPDSMAPLEN 200 // maximum template map length struct pdstemplate @@ -90,10 +97,29 @@ // 4.14: Derived Fcst based on Ensemble cluster over circular // area at Horiz Level/Layer in a time interval {14,44,1, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4,1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4} }, + // 4.15: Average, accumulation, extreme values or other statistically-processed values over a + // spatial area at a horizontal level or in a horizontal layer at a point in time + {15,18,0, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1} }, // 4.20: Radar Product {20,19,0, {1,1,1,1,1,-4,4,2,4,2,1,1,1,1,1,2,1,3,2} }, // 4.30: Satellite Product {30,5,1, {1,1,1,1,1} }, + // 4.31: Satellite Product + {31,5,1, {1,1,1,1,1} }, + // 4.40: Analysis or forecast at a horizontal level or in a horizontal layer + // at a point in time for atmospheric chemical constituents + {40,16,0, {1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4} }, + // 4.41: Individual ensemble forecast, control and perturbed, at a horizontal level or + // in a horizontal layer at a point in time for atmospheric chemical constituents + {41,19,0, {1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1} }, + // 4.42: Average, accumulation, and/or extreme values or other statistically-processed values + // at a horizontal level or in a horizontal layer in a continuous or non-continuous + // time interval for atmospheric chemical constituents + {42,30,1, {1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,1,1,1,4,1,4} }, + // 4.43: Individual ensemble forecast, control and perturbed, at a horizontal level + // or in a horizontal layer in a continuous or non-continuous + // time interval for atmospheric chemical constituents + {43,33,1, {1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1,4,1,1,1,4,1,4} }, // 4.254: CCITT IA5 Character String {254,3,0, {1,1,4} }, // 4.1000: Cross section of analysis or forecast @@ -110,7 +136,47 @@ {1100,15,0, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4} }, // 4.1100: Hovmoller-type grid with averaging or other // statistical processing - {1101,22,0, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4} } + {1101,22,0, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4} }, + // 4.32:Simulate (synthetic) Satellite Product + {32,10,1, {1,1,1,1,1,2,1,1,2,1} }, + // 4.44: Analysis or forecast at a horizontal level or in a horizontal layer + // at a point in time for Aerosol + {44,21,0, {1,1,2,1,-1,-4,-1,-4,1,1,1,2,1,1,2,1,-1,-4,1,-1,-4} }, + // 4.45: Individual ensemble forecast, control and + // perturbed, at a horizontal level or in a horizontal layer + // at a point in time for Aerosol + {45,24,0, {1,1,2,1,-1,-4,-1,-4,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1} }, + // 4.46: Ave or Accum or Extreme value at level/layer + // at horizontal level or in a horizontal in a continuous or + // non-continuous time interval for Aerosol + {46,35,1, {1,1,2,1,-1,-4,-1,-4,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,1,1,1,4,1,4} }, + // 4.47: Individual ensemble forecast, control and + // perturbed, at horizontal level or in a horizontal + // in a continuous or non-continuous time interval for Aerosol + {47,38,1, {1,1,1,2,1,-1,-4,-1,-4,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1,4,1,1,1,4,1,4} }, + + // VALIDATION --- PDT 4.48 + // 4.48: Analysis or forecast at a horizontal level or in a horizontal layer + // at a point in time for Optical Properties of Aerosol + {48,26,0, {1,1,2,1,-1,-4,-1,-4,1,-1,-4,-1,-4,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4} }, + + // VALIDATION --- PDT 4.50 + // 4.50: Analysis or forecast of multi component parameter or + // matrix element at a point in time + {50,21,0, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,4,4,4,4} }, + + // VALIDATIONi --- PDT 4.52 + // 4.52: Analysis or forecast of Wave parameters + // at the Sea surface at a point in time + {52,15,0, {1,1,1,1,1,1,1,1,2,1,1,4,1,-1,-4} }, + + // 4.51: Categorical forecasts at a horizontal level or + // in a horizontal layer at a point in time + {51,16,1, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1} }, + // 4.91: Categorical forecasts at a horizontal level or + // in a horizontal layer at a point in time + // in a continuous or non-continuous time interval + {91,16,1, {1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1} } } ; diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pngpack.c b/nativeLib/rary.cots.g2clib/pngpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pngpack.c rename to nativeLib/rary.cots.g2clib/pngpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pngunpack.c b/nativeLib/rary.cots.g2clib/pngunpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/pngunpack.c rename to nativeLib/rary.cots.g2clib/pngunpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/rdieee.c b/nativeLib/rary.cots.g2clib/rdieee.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/rdieee.c rename to nativeLib/rary.cots.g2clib/rdieee.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/reduce.c b/nativeLib/rary.cots.g2clib/reduce.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/reduce.c rename to nativeLib/rary.cots.g2clib/reduce.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/seekgb.c b/nativeLib/rary.cots.g2clib/seekgb.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/seekgb.c rename to nativeLib/rary.cots.g2clib/seekgb.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/simpack.c b/nativeLib/rary.cots.g2clib/simpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/simpack.c rename to nativeLib/rary.cots.g2clib/simpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/simunpack.c b/nativeLib/rary.cots.g2clib/simunpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/simunpack.c rename to nativeLib/rary.cots.g2clib/simunpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/specpack.c b/nativeLib/rary.cots.g2clib/specpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/specpack.c rename to nativeLib/rary.cots.g2clib/specpack.c diff --git a/nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/specunpack.c b/nativeLib/rary.cots.g2clib/specunpack.c similarity index 100% rename from nativeLib/ncep_grib2module/dependencies/src/g2clib-1.1.8/specunpack.c rename to nativeLib/rary.cots.g2clib/specunpack.c diff --git a/nativeLib/rary.cots.jepp/.cproject b/nativeLib/rary.cots.jepp/.cproject index 3b99ad9f87..a95b772a52 100644 --- a/nativeLib/rary.cots.jepp/.cproject +++ b/nativeLib/rary.cots.jepp/.cproject @@ -1,7 +1,5 @@ - - - + diff --git a/nativeLib/rary.empty.motif/.cproject b/nativeLib/rary.empty.motif/.cproject index 0bdcb332a1..c7a3e7707e 100644 --- a/nativeLib/rary.empty.motif/.cproject +++ b/nativeLib/rary.empty.motif/.cproject @@ -1,420 +1,421 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.empty.motif/src/X11.c b/nativeLib/rary.empty.motif/src/X11.c index 66e52cb8eb..478e0839ad 100644 --- a/nativeLib/rary.empty.motif/src/X11.c +++ b/nativeLib/rary.empty.motif/src/X11.c @@ -7,8 +7,6 @@ #include "error.h" -void XDestroyRegion () {nolibError("Motif");} - void XFreeFont () {nolibError("Motif");} void XGetWindowAttributes () {nolibError("Motif");} @@ -17,8 +15,6 @@ void XGrabButton () {nolibError("Motif");} void XLoadFont () {nolibError("Motif");} void XMapWindow () {nolibError("Motif");} -void XPointInRegion () {nolibError("Motif");} -void XPolygonRegion () {nolibError("Motif");} void XQueryColor () {nolibError("Motif");} void XQueryFont () {nolibError("Motif");} void XReadBitmapFile () {nolibError("Motif");} diff --git a/nativeLib/rary.meteorological/src/solax.f b/nativeLib/rary.meteorological/src/solax.f index e41240ad41..8d7a4a8602 100755 --- a/nativeLib/rary.meteorological/src/solax.f +++ b/nativeLib/rary.meteorological/src/solax.f @@ -1,9 +1,9 @@ SUBROUTINE SOLAX ( JULDAY, !Julian day (ddd) - . MONTH, !Month number of year - . SLAT, !Station latitude (deg) - . TYMINC, !Summation time increment (min) - . TSTART, !Local time to start summation (hr) - . TSTOP, !Local time (24 hr clock) to stop + . MONTH, !Month number of year + . SLAT, !Station latitude (deg) + . TYMINC, !Summation time increment (min) + . TSTART, !Local time to start summation (hr) + . TSTOP, !Local time (24 hr clock) to stop . TSRAD) !Output: solar rad. @ top of atm (ly) C========================================================================== @@ -41,9 +41,9 @@ c ---------------- . .196,.205,.207,.201, . .177,.160,.149,.142/, - . SDF /.058,.060,.071,.097, - . .121,.134,.136,.122, - . .092,.073,.063,.057/ + . SDF /.058,.060,.071,.097, + . .121,.134,.136,.122, + . .092,.073,.063,.057/ C--------------------------------------------------------------------------- diff --git a/nativeLib/rary.ohd.pproc/.cproject b/nativeLib/rary.ohd.pproc/.cproject index 491f807a58..615d1b8513 100644 --- a/nativeLib/rary.ohd.pproc/.cproject +++ b/nativeLib/rary.ohd.pproc/.cproject @@ -1,359 +1,359 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.wfoapi.getTestMode/.cproject b/nativeLib/rary.wfoapi.getTestMode/.cproject index d91c8ab1ab..1c819a935a 100644 --- a/nativeLib/rary.wfoapi.getTestMode/.cproject +++ b/nativeLib/rary.wfoapi.getTestMode/.cproject @@ -1,951 +1,535 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.wfoapi.getTestMode/src/getTestMode.C b/nativeLib/rary.wfoapi.getTestMode/src/getTestMode.C index 49ce749a1c..5996e9453c 100644 --- a/nativeLib/rary.wfoapi.getTestMode/src/getTestMode.C +++ b/nativeLib/rary.wfoapi.getTestMode/src/getTestMode.C @@ -102,7 +102,6 @@ #include #include #include -#include "LogStream.H" #include "testmode.H" #define DEVRUN true @@ -209,7 +208,7 @@ int main(int argc, char *argv[]) int rc = 0; int runLocal = 0; // Meaning both xt and lx workstations are present - logVerbose << "Startup" << std::endl; + std::cout << "Startup" << std::endl; if (argc > 3) ExitWithHelp(); diff --git a/nativeLib/rary.wfoapi.getTestMode/src/sockhelp.C b/nativeLib/rary.wfoapi.getTestMode/src/sockhelp.C index 184ce9be38..22b1a0b008 100644 --- a/nativeLib/rary.wfoapi.getTestMode/src/sockhelp.C +++ b/nativeLib/rary.wfoapi.getTestMode/src/sockhelp.C @@ -8,6 +8,7 @@ // ---************************************************************************* #include #include +#include #include #include #include @@ -15,7 +16,6 @@ #include #include #include "sockhelp.H" -#include "LogStream.H" #include "testmode.H" // +++ Function Name: atoport @@ -263,7 +263,7 @@ int getTestModeQuery(char *hostname, int port) ssize_t status = -1; sock = make_connection(DEFAULT_PORT_NUM, SOCK_STREAM, hostname, port); - logVerbose << "Connected on socket " << sock << std::endl; + std::cout << "Connected on socket " << sock << std::endl; if (sock == -1) { close(sock); return OPERATION_MODE; @@ -273,13 +273,13 @@ int getTestModeQuery(char *hostname, int port) sprintf(input_buf.msg,"RequestForTestModeInfo"); send(sock,(const void*) &input_buf, sizeof(input_buf),0); - logVerbose << "Sent socket msg """ << input_buf.msg << """" << std::endl; + std::cout << "Sent socket msg """ << input_buf.msg << """" << std::endl; status = recv(sock, (void*) &output_buf,sizeof(output_buf),0); close(sock); if (status != -1) { - logVerbose << "Received socket msg """ << output_buf.msg + std::cout << "Received socket msg """ << output_buf.msg << """" << std::endl; if (strcmp(output_buf.msg,"Test")== 0) { return TEST_MODE; @@ -296,7 +296,7 @@ int getTestModeQuery(char *hostname, int port) } else { - logVerbose << "Warning - No socket msg was received; everything will crash!" << std::endl; + std::cout << "Warning - No socket msg was received; everything will crash!" << std::endl; return PANIC_MODE; } } diff --git a/nativeLib/rary.wfoapi.showBanner/src/showBanner.C b/nativeLib/rary.wfoapi.showBanner/src/showBanner.C index cafc341753..d3b4265403 100644 --- a/nativeLib/rary.wfoapi.showBanner/src/showBanner.C +++ b/nativeLib/rary.wfoapi.showBanner/src/showBanner.C @@ -24,7 +24,6 @@ #include // for signal #include "tmbUtil.H" #include "testmode.H" -#include "LogStream.H" #define MAX_DISPLAYS 5 #define FONT_NAME "-*-helvetica-bold-r-normal--12-*" #define INTERVAL 2000 // number of milliseconds to go off diff --git a/nativeLib/rary.wfoapi.test_WorkstationTestMode/.cproject b/nativeLib/rary.wfoapi.test_WorkstationTestMode/.cproject index 630423a47f..7aa9f94cc7 100644 --- a/nativeLib/rary.wfoapi.test_WorkstationTestMode/.cproject +++ b/nativeLib/rary.wfoapi.test_WorkstationTestMode/.cproject @@ -1,952 +1,536 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.wfoapi.test_WorkstationTestMode/src/sockhelp.C b/nativeLib/rary.wfoapi.test_WorkstationTestMode/src/sockhelp.C index 184ce9be38..22b1a0b008 100644 --- a/nativeLib/rary.wfoapi.test_WorkstationTestMode/src/sockhelp.C +++ b/nativeLib/rary.wfoapi.test_WorkstationTestMode/src/sockhelp.C @@ -8,6 +8,7 @@ // ---************************************************************************* #include #include +#include #include #include #include @@ -15,7 +16,6 @@ #include #include #include "sockhelp.H" -#include "LogStream.H" #include "testmode.H" // +++ Function Name: atoport @@ -263,7 +263,7 @@ int getTestModeQuery(char *hostname, int port) ssize_t status = -1; sock = make_connection(DEFAULT_PORT_NUM, SOCK_STREAM, hostname, port); - logVerbose << "Connected on socket " << sock << std::endl; + std::cout << "Connected on socket " << sock << std::endl; if (sock == -1) { close(sock); return OPERATION_MODE; @@ -273,13 +273,13 @@ int getTestModeQuery(char *hostname, int port) sprintf(input_buf.msg,"RequestForTestModeInfo"); send(sock,(const void*) &input_buf, sizeof(input_buf),0); - logVerbose << "Sent socket msg """ << input_buf.msg << """" << std::endl; + std::cout << "Sent socket msg """ << input_buf.msg << """" << std::endl; status = recv(sock, (void*) &output_buf,sizeof(output_buf),0); close(sock); if (status != -1) { - logVerbose << "Received socket msg """ << output_buf.msg + std::cout << "Received socket msg """ << output_buf.msg << """" << std::endl; if (strcmp(output_buf.msg,"Test")== 0) { return TEST_MODE; @@ -296,7 +296,7 @@ int getTestModeQuery(char *hostname, int port) } else { - logVerbose << "Warning - No socket msg was received; everything will crash!" << std::endl; + std::cout << "Warning - No socket msg was received; everything will crash!" << std::endl; return PANIC_MODE; } } diff --git a/nativeLib/rary.wfoapi.tmb/.cproject b/nativeLib/rary.wfoapi.tmb/.cproject index 837dc769b2..6cbef15b29 100644 --- a/nativeLib/rary.wfoapi.tmb/.cproject +++ b/nativeLib/rary.wfoapi.tmb/.cproject @@ -1,953 +1,536 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.wfoapi.tmb/src/sockhelp.C b/nativeLib/rary.wfoapi.tmb/src/sockhelp.C index 184ce9be38..22b1a0b008 100644 --- a/nativeLib/rary.wfoapi.tmb/src/sockhelp.C +++ b/nativeLib/rary.wfoapi.tmb/src/sockhelp.C @@ -8,6 +8,7 @@ // ---************************************************************************* #include #include +#include #include #include #include @@ -15,7 +16,6 @@ #include #include #include "sockhelp.H" -#include "LogStream.H" #include "testmode.H" // +++ Function Name: atoport @@ -263,7 +263,7 @@ int getTestModeQuery(char *hostname, int port) ssize_t status = -1; sock = make_connection(DEFAULT_PORT_NUM, SOCK_STREAM, hostname, port); - logVerbose << "Connected on socket " << sock << std::endl; + std::cout << "Connected on socket " << sock << std::endl; if (sock == -1) { close(sock); return OPERATION_MODE; @@ -273,13 +273,13 @@ int getTestModeQuery(char *hostname, int port) sprintf(input_buf.msg,"RequestForTestModeInfo"); send(sock,(const void*) &input_buf, sizeof(input_buf),0); - logVerbose << "Sent socket msg """ << input_buf.msg << """" << std::endl; + std::cout << "Sent socket msg """ << input_buf.msg << """" << std::endl; status = recv(sock, (void*) &output_buf,sizeof(output_buf),0); close(sock); if (status != -1) { - logVerbose << "Received socket msg """ << output_buf.msg + std::cout << "Received socket msg """ << output_buf.msg << """" << std::endl; if (strcmp(output_buf.msg,"Test")== 0) { return TEST_MODE; @@ -296,7 +296,7 @@ int getTestModeQuery(char *hostname, int port) } else { - logVerbose << "Warning - No socket msg was received; everything will crash!" << std::endl; + std::cout << "Warning - No socket msg was received; everything will crash!" << std::endl; return PANIC_MODE; } } diff --git a/nativeLib/rary.wfoapi.tmb_exit/.cproject b/nativeLib/rary.wfoapi.tmb_exit/.cproject index eb097f7f77..c6bf784845 100644 --- a/nativeLib/rary.wfoapi.tmb_exit/.cproject +++ b/nativeLib/rary.wfoapi.tmb_exit/.cproject @@ -1,951 +1,535 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/nativeLib/rary.wfoapi.tmb_exit/src/sockhelp.C b/nativeLib/rary.wfoapi.tmb_exit/src/sockhelp.C index 184ce9be38..22b1a0b008 100644 --- a/nativeLib/rary.wfoapi.tmb_exit/src/sockhelp.C +++ b/nativeLib/rary.wfoapi.tmb_exit/src/sockhelp.C @@ -8,6 +8,7 @@ // ---************************************************************************* #include #include +#include #include #include #include @@ -15,7 +16,6 @@ #include #include #include "sockhelp.H" -#include "LogStream.H" #include "testmode.H" // +++ Function Name: atoport @@ -263,7 +263,7 @@ int getTestModeQuery(char *hostname, int port) ssize_t status = -1; sock = make_connection(DEFAULT_PORT_NUM, SOCK_STREAM, hostname, port); - logVerbose << "Connected on socket " << sock << std::endl; + std::cout << "Connected on socket " << sock << std::endl; if (sock == -1) { close(sock); return OPERATION_MODE; @@ -273,13 +273,13 @@ int getTestModeQuery(char *hostname, int port) sprintf(input_buf.msg,"RequestForTestModeInfo"); send(sock,(const void*) &input_buf, sizeof(input_buf),0); - logVerbose << "Sent socket msg """ << input_buf.msg << """" << std::endl; + std::cout << "Sent socket msg """ << input_buf.msg << """" << std::endl; status = recv(sock, (void*) &output_buf,sizeof(output_buf),0); close(sock); if (status != -1) { - logVerbose << "Received socket msg """ << output_buf.msg + std::cout << "Received socket msg """ << output_buf.msg << """" << std::endl; if (strcmp(output_buf.msg,"Test")== 0) { return TEST_MODE; @@ -296,7 +296,7 @@ int getTestModeQuery(char *hostname, int port) } else { - logVerbose << "Warning - No socket msg was received; everything will crash!" << std::endl; + std::cout << "Warning - No socket msg was received; everything will crash!" << std::endl; return PANIC_MODE; } } diff --git a/nativeLib/rary.wfoapi.tmcp/src/tmcp.C b/nativeLib/rary.wfoapi.tmcp/src/tmcp.C index 4a061cd422..6120756a48 100644 --- a/nativeLib/rary.wfoapi.tmcp/src/tmcp.C +++ b/nativeLib/rary.wfoapi.tmcp/src/tmcp.C @@ -900,7 +900,7 @@ static void events_handler( Widget w, XtPointer client_data, XtPointer call_data { int rc; int pc; // pre-condition flag - int which = (int) client_data; + int which = (long) client_data; XmString label; XmString button_label; char command[512]; diff --git a/rpms/awips2.core/Installer.ldm/component.spec b/rpms/awips2.core/Installer.ldm/component.spec index a2d7e31853..8830cf5b20 100644 --- a/rpms/awips2.core/Installer.ldm/component.spec +++ b/rpms/awips2.core/Installer.ldm/component.spec @@ -9,7 +9,7 @@ Name: awips2-ldm Summary: AWIPS II LDM Distribution Version: %{_ldm_version} -Release: 8 +Release: 9 Group: AWIPSII BuildRoot: /tmp BuildArch: noarch @@ -177,7 +177,9 @@ chown -R ldm:fxalpha ${_ldm_dir} # create .bash_profile if [ ! -f /usr/local/ldm/.bash_profile ]; then - echo 'export PATH=$HOME/decoders:$HOME/util:$HOME/bin:$PATH' > \ + echo 'umask 002' > \ + /usr/local/ldm/.bash_profile + echo 'export PATH=$HOME/decoders:$HOME/util:$HOME/bin:$PATH' >> \ /usr/local/ldm/.bash_profile echo 'export MANPATH=$HOME/share/man:/usr/share/man' >> \ /usr/local/ldm/.bash_profile diff --git a/rpms/awips2.core/Installer.ldm/patch/init.d/ldmcp b/rpms/awips2.core/Installer.ldm/patch/init.d/ldmcp index 5e923f09e5..165868959c 100644 --- a/rpms/awips2.core/Installer.ldm/patch/init.d/ldmcp +++ b/rpms/awips2.core/Installer.ldm/patch/init.d/ldmcp @@ -30,12 +30,12 @@ function handle_ramdisk() { if ! mount | grep ram0 > /dev/null then echo -ne "Creating RAMDISK:\t" - if mkfs -t ext2 -m 0 -q /dev/ramdisk 1500000 && success || failure + if mkfs -t ext2 -m 0 -q /dev/ram0 1500000 && success || failure then echo # mount to /data/ldm/data echo -ne "Mounting to /data/ldm/data:\t" - if ! mount /dev/ramdisk /data/ldm/data && failure + if ! mount /dev/ram0 /data/ldm/data && failure then echo return 1 diff --git a/rpms/awips2.core/Installer.ldm/src/ldm-6.11.5.tar.gz b/rpms/awips2.core/Installer.ldm/src/ldm-6.11.5.tar.gz index 72cec41394..90a6aee428 100644 Binary files a/rpms/awips2.core/Installer.ldm/src/ldm-6.11.5.tar.gz and b/rpms/awips2.core/Installer.ldm/src/ldm-6.11.5.tar.gz differ diff --git a/rpms/awips2.core/Installer.python/component.spec b/rpms/awips2.core/Installer.python/component.spec index c3f1324318..1dd94a2804 100644 --- a/rpms/awips2.core/Installer.python/component.spec +++ b/rpms/awips2.core/Installer.python/component.spec @@ -9,7 +9,7 @@ Name: awips2-python Summary: AWIPS II Python Distribution Version: 2.7.1 -Release: 8.el6 +Release: 9.el6 Group: AWIPSII BuildRoot: %{_build_root} BuildArch: %{_build_arch} diff --git a/rpms/awips2.core/Installer.python/nativeLib/x86_64/grib2.so b/rpms/awips2.core/Installer.python/nativeLib/x86_64/grib2.so old mode 100644 new mode 100755 index 208826d9ca..377bb50035 Binary files a/rpms/awips2.core/Installer.python/nativeLib/x86_64/grib2.so and b/rpms/awips2.core/Installer.python/nativeLib/x86_64/grib2.so differ diff --git a/rpms/build/x86_64/build.sh b/rpms/build/x86_64/build.sh index 3dbb6b8c3e..61241b182d 100644 --- a/rpms/build/x86_64/build.sh +++ b/rpms/build/x86_64/build.sh @@ -400,13 +400,14 @@ if [ "${1}" = "-viz" ]; then buildRPM "awips2" buildRPM "awips2-common-base" #buildRPM "awips2-python-dynamicserialize" - #buildRPM "awips2-adapt-native" + buildRPM "awips2-python" + buildRPM "awips2-adapt-native" #unpackHttpdPypies #if [ $? -ne 0 ]; then # exit 1 #fi #buildRPM "awips2-httpd-pypies" - #buildRPM "awips2-hydroapps-shared" + buildRPM "awips2-hydroapps-shared" #buildRPM "awips2-rcm" #buildRPM "awips2-tools" #buildRPM "awips2-cli" @@ -435,7 +436,9 @@ if [ "${1}" = "-custom" ]; then #if [ $? -ne 0 ]; then # exit 1 #fi - buildRPM "awips2-alertviz" + buildRPM "awips2-adapt-native" + buildRPM "awips2-hydroapps-shared" + #buildRPM "awips2-alertviz" #buildRPM "awips2-python" #buildRPM "awips2-alertviz" #buildRPM "awips2-eclipse"