ECC-633: Fortran examples: looping over messages

This commit is contained in:
Shahram Najm 2023-08-17 12:50:33 +00:00
parent ab3c0ce28d
commit 41d9d5c7f1
11 changed files with 51 additions and 100 deletions

View File

@ -7,7 +7,6 @@
! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
!
!
!
! Description: How to read attributes of keys in BUFR messages.
!
!
@ -24,11 +23,11 @@ program bufr_attributes
call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r')
! the first BUFR message is loaded from file
! ibufr is the BUFR id to be used in subsequent calls
call codes_bufr_new_from_file(ifile, ibufr, iret)
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
! A BUFR message is loaded from the file,
! ibufr is the BUFR id to be used in subsequent calls
call codes_bufr_new_from_file(ifile, ibufr, iret)
if (iret == CODES_END_OF_FILE) exit
! Get and print some keys from the BUFR header
write (*, *) 'message: ', count
@ -98,9 +97,6 @@ program bufr_attributes
! Release the BUFR message
call codes_release(ibufr)
! Load the next BUFR message
call codes_bufr_new_from_file(ifile, ibufr, iret)
count = count + 1
end do

View File

@ -6,8 +6,6 @@
! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by
! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
!
!
!
! Description: How to read all the expanded data values from BUFR messages.
!
!
@ -20,15 +18,13 @@ program bufr_expanded
integer :: i
integer :: count = 0
integer(kind=4) :: numberOfValues
real(kind=8), dimension(:), allocatable :: values
real(kind=8), dimension(:), allocatable :: values
call codes_open_file(ifile, '../../data/bufr/syno_1.bufr', 'r')
! The first bufr message is loaded from file,
! ibufr is the bufr id to be used in subsequent calls
call codes_bufr_new_from_file(ifile, ibufr, iret)
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_bufr_new_from_file(ifile, ibufr, iret)
if (iret == CODES_END_OF_FILE) exit
write (*, *) 'message: ', count
@ -47,9 +43,6 @@ program bufr_expanded
! Release the bufr message
call codes_release(ibufr)
! Load the next bufr message
call codes_bufr_new_from_file(ifile, ibufr, iret)
! Free array
deallocate (values)
@ -57,7 +50,6 @@ program bufr_expanded
end do
! Close file
call codes_close_file(ifile)
end program bufr_expanded

View File

@ -25,11 +25,9 @@ program bufr_read_scatterometer
call codes_open_file(ifile, '../../data/bufr/asca_139.bufr', 'r')
! The first BUFR message is loaded from file,
! ibufr is the bufr id to be used in subsequent calls
call codes_bufr_new_from_file(ifile, ibufr, iret)
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_bufr_new_from_file(ifile, ibufr, iret)
if (iret == CODES_END_OF_FILE) exit
write (*, '(A,I3)') 'message: ', count
@ -80,17 +78,13 @@ program bufr_read_scatterometer
deallocate (lonVal)
deallocate (bscatterVal)
! Release the bufr message
! Release the BUFR message
call codes_release(ibufr)
! Load the next bufr message
call codes_bufr_new_from_file(ifile, ibufr, iret)
count = count + 1
end do
! Close file
call codes_close_file(ifile)
end program bufr_read_scatterometer

View File

@ -7,14 +7,11 @@
! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
!
!
!
! Description: How to read SYNOP BUFR messages.
!
! Please note that SYNOP reports can be encoded in various ways in BUFR. Therefore the code
! below might not work directly for other types of SYNOP messages than the one used in the
! example. It is advised to use bufr_dump first to understand the structure of these messages.
!
!
program bufr_read_synop
use eccodes
@ -29,11 +26,9 @@ program bufr_read_synop
call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r')
! The first bufr message is loaded from file,
! ibufr is the bufr id to be used in subsequent calls
call codes_bufr_new_from_file(ifile, ibufr, iret)
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_bufr_new_from_file(ifile, ibufr, iret)
if (iret == CODES_END_OF_FILE) exit
write (*, *) 'message: ', count
@ -105,9 +100,6 @@ program bufr_read_synop
! Release the bufr message
call codes_release(ibufr)
! Load the next bufr message
call codes_bufr_new_from_file(ifile, ibufr, iret)
count = count + 1
end do

View File

@ -9,15 +9,14 @@
!
! Description: How to set different type of keys in BUFR messages.
!
!
program bufr_set_keys
use eccodes
implicit none
integer :: iret
integer :: infile, outfile
integer :: ibufr
integer :: count = 0
integer(kind=4) :: centre, centreNew
integer :: iret
integer :: infile, outfile
integer :: ibufr
integer :: count = 0
integer(kind=4) :: centre, centreNew
! Open input file
call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r')
@ -25,16 +24,14 @@ program bufr_set_keys
! Open output file
call codes_open_file(outfile, 'bufr_set_keys_test_f.tmp.bufr', 'w')
! The first bufr message is loaded from file,
! ibufr is the bufr id to be used in subsequent calls
call codes_bufr_new_from_file(infile, ibufr, iret)
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_bufr_new_from_file(infile, ibufr, iret)
if (iret == CODES_END_OF_FILE) exit
write (*, *) 'message: ', count
! This is the place where you may wish to modify the message
! E.g. we change the centre
! E.g. change the centre
! Set centre
centre = 222
@ -52,11 +49,7 @@ program bufr_set_keys
! Release the handle
call codes_release(ibufr)
! Next message from source
call codes_bufr_new_from_file(infile, ibufr, iret)
count = count + 1
end do
call codes_close_file(infile)

View File

@ -7,7 +7,6 @@
! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
!
!
!
! Description: how to process a file containing a mix of messages
! and print the kind of product (e.g. GRIB, BUFR etc)
!
@ -37,11 +36,9 @@ program get_product_kind
write (*, *) ' ECCODES_SETTINGS_PNG: ', ECCODES_SETTINGS_PNG
write (*, *) ' ECCODES_SETTINGS_AEC: ', ECCODES_SETTINGS_AEC
! the first message is loaded from file
! ihandle is the message id to be used in subsequent calls
call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret)
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret)
if (iret == CODES_END_OF_FILE) exit
write (*, *) 'message: ', count
@ -52,11 +49,7 @@ program get_product_kind
! release the message
call codes_release(ihandle)
! load the next message
call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret)
count = count + 1
end do
! close file

View File

@ -24,8 +24,10 @@ program grib_ecc_1316
call codes_index_select(idx, 'number', 0)
call codes_index_select(idx, 'parameterName', 'Soil moisture')
call codes_new_from_index(idx, igrib, iret)
do while (iret /= CODES_END_OF_INDEX)
do while (.true.)
call codes_new_from_index(idx, igrib, iret)
if (iret == CODES_END_OF_INDEX) exit
count1 = count1 + 1
call codes_get(igrib, 'parameterName', parameterName)
call codes_get(igrib, 'number', onumber)
@ -36,7 +38,6 @@ program grib_ecc_1316
' level=', olevel, &
' step=', ostep
call codes_release(igrib)
call codes_new_from_index(idx, igrib, iret)
end do
call codes_release(igrib)

View File

@ -11,8 +11,6 @@
! How to use keys_iterator to get all the available
! keys in a GRIB message.
!
!
!
program keys_iterator
use eccodes
implicit none
@ -26,35 +24,32 @@ program keys_iterator
call codes_open_file(ifile, &
'../../data/regular_latlon_surface.grib1', 'r')
! Loop on all the messages in a file.
call codes_grib_new_from_file(ifile, igrib, iret)
! Loop on all the messages in a file
grib_count = 0
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_grib_new_from_file(ifile, igrib, iret)
if (iret == CODES_END_OF_FILE) exit
grib_count = grib_count + 1
write (*, *) '-- GRIB N. ', grib_count, ' --'
! valid name_spaces are ls and mars
! Choose a namespace. E.g. "ls", "time", "parameter", "geography", "statistics"
name_space = 'ls'
call codes_keys_iterator_new(igrib, kiter, name_space)
do
call codes_keys_iterator_next(kiter, iret)
if (iret .ne. CODES_SUCCESS) exit !terminate the loop
call codes_keys_iterator_get_name(kiter, key)
call codes_get(igrib, trim(key), value)
all1 = trim(key)//' = '//trim(value)
write (*, *) trim(all1)
end do
call codes_keys_iterator_delete(kiter)
call codes_release(igrib)
call codes_grib_new_from_file(ifile, igrib, iret)
end do
call codes_close_file(ifile)

View File

@ -10,15 +10,15 @@
! Description: How to decode GRIB2 multi-field messages.
! Try to turn multi support on and off to
! see the difference. Default is OFF.
! For all the tools default is multi support ON.
! For all the tools (e.g., grib_ls etc) multi support is ON.
!
program multi
use eccodes
implicit none
integer :: iret
integer(kind=4) :: step
integer :: ifile, igrib
integer :: iret
integer(kind=4) :: step
integer :: ifile, igrib
call codes_open_file(ifile, '../../data/multi_created.grib2', 'r')
@ -28,17 +28,14 @@ program multi
! turn off support for multi-field messages */
!call codes_grib_multi_support_off()
call codes_grib_new_from_file(ifile, igrib, iret)
! Loop on all the messages in a file.
! Loop on all the messages in a file
write (*, *) 'step'
do while (iret /= CODES_END_OF_FILE)
do while (.true.)
call codes_grib_new_from_file(ifile, igrib, iret)
if (iret == CODES_END_OF_FILE) exit
call codes_get(igrib, 'step', step)
write (*, '(i3)') step
call codes_grib_new_from_file(ifile, igrib, iret)
end do
call codes_close_file(ifile)

View File

@ -9,7 +9,6 @@
!
! Description: How to create a new GRIB message from a sample.
!
!
program sample
use eccodes
implicit none
@ -29,7 +28,7 @@ program sample
indicatorOfParameter = 61
decimalPrecision = 2
! a new GRIB message is loaded from an existing sample.
! A new GRIB message is loaded from an existing sample.
! Samples are searched in a default sample path (use codes_info
! to see where that is). The default sample path can be changed by
! setting the environment variable ECCODES_SAMPLES_PATH

View File

@ -26,10 +26,11 @@ program iterator
call codes_open_file(ifile, &
'../../data/regular_latlon_surface_constant.grib1', 'R')
! Loop on all the messages in a file.
call codes_grib_new_from_file(ifile, igrib, iret)
! Loop on all the messages in a file
LOOP: DO WHILE (.true.)
call codes_grib_new_from_file(ifile, igrib, iret)
if (iret == CODES_END_OF_FILE) exit LOOP
LOOP: DO WHILE (iret /= CODES_END_OF_FILE)
! get as a real8
call codes_get(igrib, &
'missingValue', missingValue)
@ -61,8 +62,6 @@ program iterator
call grib_iterator_delete(iter)
call codes_release(igrib)
call codes_grib_new_from_file(ifile, igrib, iret)
end do LOOP
call codes_close_file(ifile)