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. ! 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. ! 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') call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r')
! the first BUFR message is loaded from file do while (.true.)
! ibufr is the BUFR id to be used in subsequent calls ! A BUFR message is loaded from the file,
call codes_bufr_new_from_file(ifile, ibufr, iret) ! 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) if (iret == CODES_END_OF_FILE) exit
! Get and print some keys from the BUFR header ! Get and print some keys from the BUFR header
write (*, *) 'message: ', count write (*, *) 'message: ', count
@ -98,9 +97,6 @@ program bufr_attributes
! Release the BUFR message ! Release the BUFR message
call codes_release(ibufr) call codes_release(ibufr)
! Load the next BUFR message
call codes_bufr_new_from_file(ifile, ibufr, iret)
count = count + 1 count = count + 1
end do end do

View File

@ -6,8 +6,6 @@
! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! 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. ! 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. ! Description: How to read all the expanded data values from BUFR messages.
! !
! !
@ -20,15 +18,13 @@ program bufr_expanded
integer :: i integer :: i
integer :: count = 0 integer :: count = 0
integer(kind=4) :: numberOfValues 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') call codes_open_file(ifile, '../../data/bufr/syno_1.bufr', 'r')
! The first bufr message is loaded from file, do while (.true.)
! ibufr is the bufr id to be used in subsequent calls call codes_bufr_new_from_file(ifile, ibufr, iret)
call codes_bufr_new_from_file(ifile, ibufr, iret) if (iret == CODES_END_OF_FILE) exit
do while (iret /= CODES_END_OF_FILE)
write (*, *) 'message: ', count write (*, *) 'message: ', count
@ -47,9 +43,6 @@ program bufr_expanded
! Release the bufr message ! Release the bufr message
call codes_release(ibufr) call codes_release(ibufr)
! Load the next bufr message
call codes_bufr_new_from_file(ifile, ibufr, iret)
! Free array ! Free array
deallocate (values) deallocate (values)
@ -57,7 +50,6 @@ program bufr_expanded
end do end do
! Close file
call codes_close_file(ifile) call codes_close_file(ifile)
end program bufr_expanded 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') call codes_open_file(ifile, '../../data/bufr/asca_139.bufr', 'r')
! The first BUFR message is loaded from file, do while (.true.)
! ibufr is the bufr id to be used in subsequent calls call codes_bufr_new_from_file(ifile, ibufr, iret)
call codes_bufr_new_from_file(ifile, ibufr, iret) if (iret == CODES_END_OF_FILE) exit
do while (iret /= CODES_END_OF_FILE)
write (*, '(A,I3)') 'message: ', count write (*, '(A,I3)') 'message: ', count
@ -80,17 +78,13 @@ program bufr_read_scatterometer
deallocate (lonVal) deallocate (lonVal)
deallocate (bscatterVal) deallocate (bscatterVal)
! Release the bufr message ! Release the BUFR message
call codes_release(ibufr) call codes_release(ibufr)
! Load the next bufr message
call codes_bufr_new_from_file(ifile, ibufr, iret)
count = count + 1 count = count + 1
end do end do
! Close file
call codes_close_file(ifile) call codes_close_file(ifile)
end program bufr_read_scatterometer 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. ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
! !
! !
!
! Description: How to read SYNOP BUFR messages. ! Description: How to read SYNOP BUFR messages.
!
! Please note that SYNOP reports can be encoded in various ways in BUFR. Therefore the code ! 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 ! 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. ! example. It is advised to use bufr_dump first to understand the structure of these messages.
!
! !
program bufr_read_synop program bufr_read_synop
use eccodes use eccodes
@ -29,11 +26,9 @@ program bufr_read_synop
call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r')
! The first bufr message is loaded from file, do while (.true.)
! ibufr is the bufr id to be used in subsequent calls call codes_bufr_new_from_file(ifile, ibufr, iret)
call codes_bufr_new_from_file(ifile, ibufr, iret) if (iret == CODES_END_OF_FILE) exit
do while (iret /= CODES_END_OF_FILE)
write (*, *) 'message: ', count write (*, *) 'message: ', count
@ -105,9 +100,6 @@ program bufr_read_synop
! Release the bufr message ! Release the bufr message
call codes_release(ibufr) call codes_release(ibufr)
! Load the next bufr message
call codes_bufr_new_from_file(ifile, ibufr, iret)
count = count + 1 count = count + 1
end do end do

View File

@ -9,15 +9,14 @@
! !
! Description: How to set different type of keys in BUFR messages. ! Description: How to set different type of keys in BUFR messages.
! !
!
program bufr_set_keys program bufr_set_keys
use eccodes use eccodes
implicit none implicit none
integer :: iret integer :: iret
integer :: infile, outfile integer :: infile, outfile
integer :: ibufr integer :: ibufr
integer :: count = 0 integer :: count = 0
integer(kind=4) :: centre, centreNew integer(kind=4) :: centre, centreNew
! Open input file ! Open input file
call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r') call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r')
@ -25,16 +24,14 @@ program bufr_set_keys
! Open output file ! Open output file
call codes_open_file(outfile, 'bufr_set_keys_test_f.tmp.bufr', 'w') call codes_open_file(outfile, 'bufr_set_keys_test_f.tmp.bufr', 'w')
! The first bufr message is loaded from file, do while (.true.)
! ibufr is the bufr id to be used in subsequent calls call codes_bufr_new_from_file(infile, ibufr, iret)
call codes_bufr_new_from_file(infile, ibufr, iret) if (iret == CODES_END_OF_FILE) exit
do while (iret /= CODES_END_OF_FILE)
write (*, *) 'message: ', count write (*, *) 'message: ', count
! This is the place where you may wish to modify the message ! 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 ! Set centre
centre = 222 centre = 222
@ -52,11 +49,7 @@ program bufr_set_keys
! Release the handle ! Release the handle
call codes_release(ibufr) call codes_release(ibufr)
! Next message from source
call codes_bufr_new_from_file(infile, ibufr, iret)
count = count + 1 count = count + 1
end do end do
call codes_close_file(infile) 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. ! 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 ! Description: how to process a file containing a mix of messages
! and print the kind of product (e.g. GRIB, BUFR etc) ! 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_PNG: ', ECCODES_SETTINGS_PNG
write (*, *) ' ECCODES_SETTINGS_AEC: ', ECCODES_SETTINGS_AEC write (*, *) ' ECCODES_SETTINGS_AEC: ', ECCODES_SETTINGS_AEC
! the first message is loaded from file do while (.true.)
! ihandle is the message id to be used in subsequent calls call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret)
call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret) if (iret == CODES_END_OF_FILE) exit
do while (iret /= CODES_END_OF_FILE)
write (*, *) 'message: ', count write (*, *) 'message: ', count
@ -52,11 +49,7 @@ program get_product_kind
! release the message ! release the message
call codes_release(ihandle) call codes_release(ihandle)
! load the next message
call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret)
count = count + 1 count = count + 1
end do end do
! close file ! close file

View File

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

View File

@ -11,8 +11,6 @@
! How to use keys_iterator to get all the available ! How to use keys_iterator to get all the available
! keys in a GRIB message. ! keys in a GRIB message.
! !
!
!
program keys_iterator program keys_iterator
use eccodes use eccodes
implicit none implicit none
@ -26,35 +24,32 @@ program keys_iterator
call codes_open_file(ifile, & call codes_open_file(ifile, &
'../../data/regular_latlon_surface.grib1', 'r') '../../data/regular_latlon_surface.grib1', 'r')
! Loop on all the messages in a file. ! Loop on all the messages in a file
call codes_grib_new_from_file(ifile, igrib, iret)
grib_count = 0 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 grib_count = grib_count + 1
write (*, *) '-- GRIB N. ', grib_count, ' --' 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' name_space = 'ls'
call codes_keys_iterator_new(igrib, kiter, name_space) call codes_keys_iterator_new(igrib, kiter, name_space)
do do
call codes_keys_iterator_next(kiter, iret) call codes_keys_iterator_next(kiter, iret)
if (iret .ne. CODES_SUCCESS) exit !terminate the loop if (iret .ne. CODES_SUCCESS) exit !terminate the loop
call codes_keys_iterator_get_name(kiter, key) call codes_keys_iterator_get_name(kiter, key)
call codes_get(igrib, trim(key), value) call codes_get(igrib, trim(key), value)
all1 = trim(key)//' = '//trim(value) all1 = trim(key)//' = '//trim(value)
write (*, *) trim(all1) write (*, *) trim(all1)
end do end do
call codes_keys_iterator_delete(kiter) call codes_keys_iterator_delete(kiter)
call codes_release(igrib) call codes_release(igrib)
call codes_grib_new_from_file(ifile, igrib, iret)
end do end do
call codes_close_file(ifile) call codes_close_file(ifile)

View File

@ -10,15 +10,15 @@
! Description: How to decode GRIB2 multi-field messages. ! Description: How to decode GRIB2 multi-field messages.
! Try to turn multi support on and off to ! Try to turn multi support on and off to
! see the difference. Default is OFF. ! 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 program multi
use eccodes use eccodes
implicit none implicit none
integer :: iret integer :: iret
integer(kind=4) :: step integer(kind=4) :: step
integer :: ifile, igrib integer :: ifile, igrib
call codes_open_file(ifile, '../../data/multi_created.grib2', 'r') call codes_open_file(ifile, '../../data/multi_created.grib2', 'r')
@ -28,17 +28,14 @@ program multi
! turn off support for multi-field messages */ ! turn off support for multi-field messages */
!call codes_grib_multi_support_off() !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' 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) call codes_get(igrib, 'step', step)
write (*, '(i3)') step write (*, '(i3)') step
call codes_grib_new_from_file(ifile, igrib, iret)
end do end do
call codes_close_file(ifile) call codes_close_file(ifile)

View File

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

View File

@ -26,10 +26,11 @@ program iterator
call codes_open_file(ifile, & call codes_open_file(ifile, &
'../../data/regular_latlon_surface_constant.grib1', 'R') '../../data/regular_latlon_surface_constant.grib1', 'R')
! Loop on all the messages in a file. ! Loop on all the messages in a file
call codes_grib_new_from_file(ifile, igrib, iret) 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 ! get as a real8
call codes_get(igrib, & call codes_get(igrib, &
'missingValue', missingValue) 'missingValue', missingValue)
@ -61,8 +62,6 @@ program iterator
call grib_iterator_delete(iter) call grib_iterator_delete(iter)
call codes_release(igrib) call codes_release(igrib)
call codes_grib_new_from_file(ifile, igrib, iret)
end do LOOP end do LOOP
call codes_close_file(ifile) call codes_close_file(ifile)