core
/
eccodes
mirror of https://github.com/ecmwf/eccodes.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

ECC-1235: Fortran examples: Show how to convert an error code into a string

This commit is contained in:
Shahram Najm 2021-04-23 13:22:45 +01:00
parent 2f26c45e69
commit ec67e1293a
1 changed files with 70 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
examples/F90/read_from_file.f90
View File

@ -10,88 +10,94 @@
! See GRIB-292 ! See GRIB-292
! !
program read_from_file program read_from_file
use eccodes use eccodes
implicit none implicit none
character(len=32) :: input_grib_file character(len=32) :: input_grib_file
integer, dimension(26) :: message_lengths ! expected message lengths integer, dimension(26) :: message_lengths ! expected message lengths
input_grib_file = '../../data/v.grib2' input_grib_file = '../../data/v.grib2'
message_lengths = (/95917, 96963, 97308, 97386, 97215, 97440, 98451, 98629, 98448, & message_lengths = (/95917, 96963, 97308, 97386, 97215, 97440, 98451, 98629, 98448, &
99186, 97517, 97466, 99307, 98460, 101491, 99361, 100292, 96838, & 99186, 97517, 97466, 99307, 98460, 101491, 99361, 100292, 96838, &
91093, 83247, 78244, 74872, 72663, 69305, 69881, 68572/) 91093, 83247, 78244, 74872, 72663, 69305, 69881, 68572/)
! Get the grib message length using two different interfaces ! Get the grib message length using two different interfaces
call read_using_size_t() call read_using_size_t()
call read_using_integer() call read_using_integer()
print *, 'Passed' print *, 'Passed'
contains contains
!====================================== !======================================
subroutine read_using_size_t subroutine read_using_size_t
implicit none implicit none
integer :: size, intsize integer :: size, intsize
parameter(intsize=100000, size=intsize*4) parameter(intsize=100000, size=intsize*4)
integer :: ifile integer :: ifile
integer :: iret integer :: iret
integer :: count1 = 0 integer :: count1 = 0
integer(kind=4), dimension(intsize) :: buffer integer(kind=4), dimension(intsize) :: buffer
integer(kind=kindOfSize_t) :: len1 ! For large messages integer(kind=kindOfSize_t) :: len1 ! For large messages
character(len=128) :: error_message
ifile = 5 ifile = 5
call codes_open_file(ifile, input_grib_file, 'r') 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)
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 len1 = size
call codes_read_from_file(ifile, buffer, len1, iret) call codes_read_from_file(ifile, buffer, len1, iret)
end do
do while (iret == CODES_SUCCESS) if (iret /= CODES_END_OF_FILE) then
count1 = count1 + 1 call codes_get_error_string(iret, error_message)
if (len1 /= message_lengths(count1)) then write (*, *) 'error message: ', error_message
write (*, '(a,i3,a,i8,a,i8)') 'Error: Message #', count1, ' length=', len1, '. Expected=', message_lengths(count1) call codes_check(iret, 'read_from_file', '')
stop end if
end if call codes_close_file(ifile)
len1 = size
call codes_read_from_file(ifile, buffer, len1, iret)
end do
if (iret /= CODES_END_OF_FILE) then end subroutine read_using_size_t
call codes_check(iret, 'read_from_file', '')
end if
call codes_close_file(ifile)
end subroutine read_using_size_t
!====================================== !======================================
subroutine read_using_integer subroutine read_using_integer
implicit none implicit none
integer :: size, intsize integer :: size, intsize
parameter(intsize=100000, size=intsize*4) parameter(intsize=100000, size=intsize*4)
integer :: ifile integer :: ifile
integer :: iret integer :: iret
integer :: count1 = 0 integer :: count1 = 0
integer(kind=4), dimension(intsize) :: buffer integer(kind=4), dimension(intsize) :: buffer
integer :: len1 integer :: len1
character(len=128) :: error_message
ifile = 5 ifile = 5
call codes_open_file(ifile, input_grib_file, 'r') 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)
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 len1 = size
call codes_read_from_file(ifile, buffer, len1, iret) call codes_read_from_file(ifile, buffer, len1, iret)
end do
do while (iret == CODES_SUCCESS) if (iret /= CODES_END_OF_FILE) then
count1 = count1 + 1 call codes_get_error_string(iret, error_message)
if (len1 /= message_lengths(count1)) then write (*, *) 'error message: ', error_message
write (*, '(a,i3,a,i8,a,i8)') 'Error: Message #', count1, ' length=', len1, '. Expected=', message_lengths(count1) call codes_check(iret, 'read_from_file', '')
stop end if
end if call codes_close_file(ifile)
len1 = size
call codes_read_from_file(ifile, buffer, len1, iret)
end do
if (iret /= CODES_END_OF_FILE) then end subroutine read_using_integer
call codes_check(iret, 'read_from_file', '')
end if
call codes_close_file(ifile)
end subroutine read_using_integer
!====================================== !======================================
end program end program