mirror of https://github.com/ecmwf/eccodes.git
101 lines
3.5 KiB
Fortran
101 lines
3.5 KiB
Fortran
! (C) Copyright 2005- ECMWF.
|
|
!
|
|
! This software is licensed under the terms of the Apache Licence Version 2.0
|
|
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
|
|
!
|
|
! 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: get/set byte array in a grib2 message, using the uuid as example.
|
|
!
|
|
! Original authors: Harald Anlauf, Doerte Liermann (DWD), Luis Kornblueh (MPIfM).
|
|
!
|
|
program grib_get_set_uuid
|
|
use eccodes
|
|
implicit none
|
|
integer :: infile, outfile
|
|
integer :: igrib, ogrib
|
|
integer :: count1, i, iret, nvg, ffs, length
|
|
character(len=1) :: uuid_in(16) ! Array of 16 bytes for uuid on input.
|
|
character(len=1) :: uuid_out(16) ! Array of 16 bytes for uuid on output.
|
|
character(len=32) :: uuid_string ! Human-readable uuid.
|
|
character(len=32) :: uuid_string_expected ! Expected UUID of input
|
|
|
|
call codes_open_file(infile, '../../data/test_uuid.grib2', 'r')
|
|
|
|
call codes_open_file(outfile, 'out_uuid.grib2', 'w')
|
|
|
|
! Load first grib message from file
|
|
! igrib is the grib id to be used in subsequent calls
|
|
call codes_grib_new_from_file(infile, igrib, iret)
|
|
|
|
uuid_string_expected = '08b1e836bc6911e1951fb51b5624ad8d'
|
|
count1 = 0
|
|
do while (iret /= CODES_END_OF_FILE)
|
|
count1 = count1 + 1
|
|
print *, "### Record:", count1
|
|
call codes_get(igrib, 'typeOfFirstFixedSurface', ffs)
|
|
print *, 'typeOfFirstFixedSurface =', ffs
|
|
if (ffs /= 150) then
|
|
print *, "Unexpected typeOfFirstFixedSurface (must be 150)."
|
|
stop
|
|
end if
|
|
|
|
call codes_get(igrib, 'numberOfVGridUsed', nvg)
|
|
print *, 'numberOfVGridUsed =', nvg
|
|
|
|
! call codes_get (igrib,'uuidOfVGrid',uuid_in) ! Assuming length is ok.
|
|
call codes_get(igrib, 'uuidOfVGrid', uuid_in, length=length)
|
|
if (length /= 16) then
|
|
print *, "Sorry, bad length of byte_array:", length, ". Expected: 16"
|
|
stop
|
|
end if
|
|
|
|
! Convert byte array to hexadecimal string for printing
|
|
do i = 1, size(uuid_in)
|
|
uuid_string(2*i - 1:2*i) = byte2hex(uuid_in(i))
|
|
end do
|
|
print *, "uuidOfVGrid (on input) = ", uuid_string
|
|
if (uuid_string .ne. uuid_string_expected) then
|
|
print *, "Sorry, bad value of byte_array. Expected: ", uuid_string_expected
|
|
stop
|
|
end if
|
|
|
|
call codes_clone(igrib, ogrib)
|
|
! On output we write a modified uuid (here the input is simply reversed)
|
|
uuid_out(1:16) = uuid_in(16:1:-1)
|
|
call codes_set(ogrib, 'uuidOfVGrid', uuid_out)
|
|
call codes_write(ogrib, outfile)
|
|
|
|
call codes_release(igrib)
|
|
call codes_release(ogrib)
|
|
call codes_grib_new_from_file(infile, igrib, iret)
|
|
end do
|
|
|
|
call codes_close_file(infile)
|
|
call codes_close_file(outfile)
|
|
|
|
contains
|
|
! Convert single byte to 'hexadecimal' string
|
|
pure function byte2hex(c) result(hex)
|
|
character(len=1), intent(in) :: c
|
|
character(len=2) :: hex
|
|
integer :: x
|
|
x = iachar(c)
|
|
hex(1:1) = nibble(x/16)
|
|
hex(2:2) = nibble(iand(x, 15))
|
|
end function byte2hex
|
|
! Convert 'nibble' to 'hexadecimal'
|
|
pure function nibble(x)
|
|
integer, intent(in) :: x
|
|
character :: nibble
|
|
select case (x)
|
|
case (0:9)
|
|
nibble = achar(iachar('0') + x)
|
|
case default
|
|
nibble = achar(iachar('a') - 10 + x)
|
|
end select
|
|
end function nibble
|
|
end program grib_get_set_uuid
|