2022-04-27 16:33:55 +00:00
|
|
|
! (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.
|
|
|
|
|
!
|
|
|
|
|
program operator_3_test
|
|
|
|
|
use eccodes
|
|
|
|
|
implicit none
|
2022-04-27 16:43:48 +00:00
|
|
|
integer :: iret, outfile, ibufr
|
|
|
|
|
integer(kind=4), dimension(:), allocatable :: ivalues
|
|
|
|
|
character(len=100) :: outfile_name
|
2022-04-27 16:33:55 +00:00
|
|
|
|
|
|
|
|
call getarg(1, outfile_name)
|
|
|
|
|
|
|
|
|
|
call codes_bufr_new_from_samples(ibufr,'BUFR4',iret)
|
|
|
|
|
if (iret /= CODES_SUCCESS) then
|
|
|
|
|
print *,'ERROR creating BUFR from BUFR4'
|
|
|
|
|
stop 1
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
allocate(ivalues(1))
|
|
|
|
|
ivalues=(/ -16383 /)
|
|
|
|
|
call codes_set(ibufr,'inputOverriddenReferenceValues',ivalues)
|
|
|
|
|
deallocate(ivalues)
|
|
|
|
|
|
|
|
|
|
allocate(ivalues(3))
|
|
|
|
|
ivalues=(/ 2,2,2 /)
|
|
|
|
|
call codes_set(ibufr,'inputExtendedDelayedDescriptorReplicationFactor',ivalues)
|
|
|
|
|
deallocate(ivalues)
|
2022-04-27 16:43:48 +00:00
|
|
|
|
2022-04-27 16:33:55 +00:00
|
|
|
call codes_set(ibufr,'masterTableNumber',0)
|
|
|
|
|
call codes_set(ibufr,'bufrHeaderCentre',254)
|
|
|
|
|
call codes_set(ibufr,'bufrHeaderSubCentre',0)
|
|
|
|
|
call codes_set(ibufr,'updateSequenceNumber',0)
|
|
|
|
|
call codes_set(ibufr,'dataCategory',21)
|
|
|
|
|
call codes_set(ibufr,'internationalDataSubCategory',5)
|
|
|
|
|
call codes_set(ibufr,'dataSubCategory',205)
|
|
|
|
|
call codes_set(ibufr,'masterTablesVersionNumber',15)
|
|
|
|
|
call codes_set(ibufr,'localTablesVersionNumber',0)
|
|
|
|
|
call codes_set(ibufr,'typicalYear',2017)
|
|
|
|
|
call codes_set(ibufr,'typicalMonth',6)
|
|
|
|
|
call codes_set(ibufr,'typicalDay',2)
|
|
|
|
|
call codes_set(ibufr,'typicalHour',10)
|
|
|
|
|
call codes_set(ibufr,'typicalMinute',49)
|
|
|
|
|
call codes_set(ibufr,'typicalSecond',44)
|
|
|
|
|
call codes_set(ibufr,'numberOfSubsets',3)
|
|
|
|
|
call codes_set(ibufr,'observedData',1)
|
|
|
|
|
!call codes_set(ibufr,'compressedData',1)
|
|
|
|
|
call codes_set(ibufr,'compressedData',0)
|
|
|
|
|
if(allocated(ivalues)) deallocate(ivalues)
|
|
|
|
|
|
|
|
|
|
allocate(ivalues(7))
|
|
|
|
|
ivalues = (/ 203015,025052,203255,025052,101000,031002,014046 /)
|
2022-04-27 16:43:48 +00:00
|
|
|
! ivalues = (/ 025052,101000,031002,014046 /)
|
2022-04-27 16:33:55 +00:00
|
|
|
call codes_set(ibufr,'unexpandedDescriptors',ivalues,iret)
|
|
|
|
|
if (iret /= CODES_SUCCESS) then
|
|
|
|
|
write(*,*)'codes_set failed for the unexpandedDescriptors'
|
|
|
|
|
stop
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
deallocate(ivalues)
|
2022-04-27 16:43:48 +00:00
|
|
|
! Negative values can now be encoded
|
|
|
|
|
call codes_set(ibufr, 'log10OfPrincipalComponentsNormalizedFitToData', -1.1)
|
2022-04-27 16:33:55 +00:00
|
|
|
|
|
|
|
|
allocate(ivalues(3))
|
|
|
|
|
ivalues = 0
|
|
|
|
|
call codes_set(ibufr,'#1#scaledIasiRadiance',ivalues)
|
|
|
|
|
call codes_set(ibufr,'#2#scaledIasiRadiance',ivalues)
|
2022-12-22 16:26:01 +00:00
|
|
|
deallocate(ivalues)
|
|
|
|
|
|
2022-04-27 16:33:55 +00:00
|
|
|
call codes_set(ibufr,'pack',1)
|
|
|
|
|
|
|
|
|
|
call codes_open_file(outfile, outfile_name, 'w')
|
|
|
|
|
call codes_write(ibufr,outfile)
|
|
|
|
|
call codes_close_file(outfile)
|
|
|
|
|
call codes_release(ibufr)
|
|
|
|
|
if(allocated(ivalues)) deallocate(ivalues)
|
|
|
|
|
end program operator_3_test
|
