From ec67e1293af120eeb838c05f7e8f8169e9fb135b Mon Sep 17 00:00:00 2001 From: Shahram Najm Date: Fri, 23 Apr 2021 13:22:45 +0100 Subject: [PATCH] ECC-1235: Fortran examples: Show how to convert an error code into a string --- examples/F90/read_from_file.f90 | 134 +++++++++++++++++--------------- 1 file changed, 70 insertions(+), 64 deletions(-) diff --git a/examples/F90/read_from_file.f90 b/examples/F90/read_from_file.f90 index 3ea16ea9f..2397fa2f0 100644 --- a/examples/F90/read_from_file.f90 +++ b/examples/F90/read_from_file.f90 @@ -10,88 +10,94 @@ ! See GRIB-292 ! program read_from_file - use eccodes - implicit none - character(len=32) :: input_grib_file - integer, dimension(26) :: message_lengths ! expected message lengths + use eccodes + implicit none + character(len=32) :: input_grib_file + integer, dimension(26) :: message_lengths ! expected message lengths - input_grib_file = '../../data/v.grib2' - message_lengths = (/95917, 96963, 97308, 97386, 97215, 97440, 98451, 98629, 98448, & - 99186, 97517, 97466, 99307, 98460, 101491, 99361, 100292, 96838, & - 91093, 83247, 78244, 74872, 72663, 69305, 69881, 68572/) + input_grib_file = '../../data/v.grib2' + message_lengths = (/95917, 96963, 97308, 97386, 97215, 97440, 98451, 98629, 98448, & + 99186, 97517, 97466, 99307, 98460, 101491, 99361, 100292, 96838, & + 91093, 83247, 78244, 74872, 72663, 69305, 69881, 68572/) - ! Get the grib message length using two different interfaces - call read_using_size_t() - call read_using_integer() - print *, 'Passed' + ! Get the grib message length using two different interfaces + call read_using_size_t() + call read_using_integer() + print *, 'Passed' contains !====================================== - subroutine read_using_size_t - implicit none - integer :: size, intsize - parameter(intsize=100000, size=intsize*4) - integer :: ifile - integer :: iret - integer :: count1 = 0 - integer(kind=4), dimension(intsize) :: buffer - integer(kind=kindOfSize_t) :: len1 ! For large messages + subroutine read_using_size_t + implicit none + integer :: size, intsize + parameter(intsize=100000, size=intsize*4) + integer :: ifile + integer :: iret + integer :: count1 = 0 + integer(kind=4), dimension(intsize) :: buffer + integer(kind=kindOfSize_t) :: len1 ! For large messages + character(len=128) :: error_message - ifile = 5 - call codes_open_file(ifile, input_grib_file, 'r') + ifile = 5 + 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 call codes_read_from_file(ifile, buffer, len1, iret) + end do - 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 - call codes_read_from_file(ifile, buffer, len1, iret) - end do + if (iret /= CODES_END_OF_FILE) then + call codes_get_error_string(iret, error_message) + write (*, *) 'error message: ', error_message + call codes_check(iret, 'read_from_file', '') + end if + call codes_close_file(ifile) - if (iret /= CODES_END_OF_FILE) then - call codes_check(iret, 'read_from_file', '') - end if - call codes_close_file(ifile) - - end subroutine read_using_size_t + end subroutine read_using_size_t !====================================== - subroutine read_using_integer - implicit none - integer :: size, intsize - parameter(intsize=100000, size=intsize*4) - integer :: ifile - integer :: iret - integer :: count1 = 0 - integer(kind=4), dimension(intsize) :: buffer - integer :: len1 + subroutine read_using_integer + implicit none + integer :: size, intsize + parameter(intsize=100000, size=intsize*4) + integer :: ifile + integer :: iret + integer :: count1 = 0 + integer(kind=4), dimension(intsize) :: buffer + integer :: len1 + character(len=128) :: error_message - ifile = 5 - call codes_open_file(ifile, input_grib_file, 'r') + ifile = 5 + 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 call codes_read_from_file(ifile, buffer, len1, iret) + end do - 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 - call codes_read_from_file(ifile, buffer, len1, iret) - end do + if (iret /= CODES_END_OF_FILE) then + call codes_get_error_string(iret, error_message) + write (*, *) 'error message: ', error_message + call codes_check(iret, 'read_from_file', '') + end if + call codes_close_file(ifile) - if (iret /= CODES_END_OF_FILE) then - call codes_check(iret, 'read_from_file', '') - end if - call codes_close_file(ifile) - - end subroutine read_using_integer + end subroutine read_using_integer !====================================== end program