! (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