ECC-633: Fortran examples: looping over messages

This commit is contained in:
Shahram Najm 2023-08-17 10:37:42 +00:00
parent ded3d5e1e3
commit ab3c0ce28d
5 changed files with 23 additions and 32 deletions

View File

@ -26,11 +26,11 @@ program bufr_get_keys
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
@ -83,9 +83,6 @@ program bufr_get_keys
! 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

@ -23,11 +23,11 @@ program bufr_read_header
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 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
@ -59,9 +59,6 @@ program bufr_read_header
! 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

@ -26,10 +26,11 @@ program get_data
call codes_open_file(ifile, '../../data/reduced_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 the file
do while (.true.)
call codes_grib_new_from_file(ifile, igrib, iret)
if (iret == CODES_END_OF_FILE) exit
do while (iret /= CODES_END_OF_FILE)
count1 = count1 + 1
print *, "===== Message #", count1
call codes_get(igrib, 'numberOfPoints', numberOfPoints)
@ -69,7 +70,6 @@ program get_data
deallocate (values)
call codes_release(igrib)
call codes_grib_new_from_file(ifile, igrib, iret)
end do

View File

@ -31,13 +31,12 @@ program grib_get_keys
call codes_open_file(ifile, '../../data/reduced_latlon_surface.grib1', open_mode)
! loop on all the messages in a file.
! a new GRIB message is loaded from file
! igrib is the grib id to be used in subsequent calls
call codes_grib_new_from_file(ifile, igrib, iret)
LOOP: DO WHILE (iret /= CODES_END_OF_FILE)
! loop on all the messages in a file
LOOP: DO WHILE (.true.)
! a new GRIB message is loaded from file.
! igrib is the grib id to be used in subsequent calls
call codes_grib_new_from_file(ifile, igrib, iret)
if (iret == CODES_END_OF_FILE) exit LOOP
! check if the value of the key is MISSING
is_missing = 0;
@ -100,8 +99,6 @@ program grib_get_keys
call codes_release(igrib)
call codes_grib_new_from_file(ifile, igrib, iret)
end do LOOP
call codes_close_file(ifile)

View File

@ -42,16 +42,16 @@ contains
call codes_open_file(ifile, input_grib_file, 'r')
len1 = size
call codes_read_from_file(ifile, buffer, len1, iret)
do while (iret == CODES_SUCCESS)
do while (.true.)
call codes_read_from_file(ifile, buffer, len1, iret)
if (iret /= CODES_SUCCESS) exit
count1 = count1 + 1
if (len1 /= message_lengths(count1)) then
write (*, '(a,i3,a,i8,a,i8)') 'Error: Message #', count1, ' length=', len1, '. Expected=', message_lengths(count1)
stop
end if
len1 = size
call codes_read_from_file(ifile, buffer, len1, iret)
end do
if (iret /= CODES_END_OF_FILE) then