diff --git a/examples/F90/bufr_attributes.f90 b/examples/F90/bufr_attributes.f90 index f1c3144dc..eb5a330ae 100644 --- a/examples/F90/bufr_attributes.f90 +++ b/examples/F90/bufr_attributes.f90 @@ -13,101 +13,100 @@ ! ! program bufr_attributes -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -integer(kind=4) :: iVal,conf -real(kind=8) :: t2m -character(len=32) :: units, confUnits + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: iVal, conf + real(kind=8) :: t2m + character(len=32) :: units, confUnits - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') ! the first bufr message is loaded from file ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! ---------------------------------------------------------------- + ! We will read the value and all the attributes available for + ! the 2m temperature. + ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! We will read the value and all the attributes available for - ! the 2m temperature. - ! ---------------------------------------------------------------- + ! Get the element's value as as real + call codes_get(ibufr, 'airTemperatureAt2M', t2m); + write (*, *) ' airTemperatureAt2M:', t2m - ! Get the element's value as as real - call codes_get(ibufr,'airTemperatureAt2M',t2m); - write(*,*) ' airTemperatureAt2M:',t2m + ! Get the element's code (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->code', iVal); + write (*, *) ' airTemperatureAt2M->code:', iVal - ! Get the element's code (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->code',iVal); - write(*,*) ' airTemperatureAt2M->code:',iVal + ! Get the element's units (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->units', units) + write (*, *) ' airTemperatureAt2M->units:', units - ! Get the element's units (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->units',units) - write(*,*) ' airTemperatureAt2M->units:',units + ! Get the element's scale (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->scale', iVal); + write (*, *) ' airTemperatureAt2M->code:', iVal - ! Get the element's scale (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->scale',iVal); - write(*,*) ' airTemperatureAt2M->code:',iVal + ! Get the element's reference (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->reference', iVal); + write (*, *) ' airTemperatureAt2M->reference:', iVal - ! Get the element's reference (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->reference',iVal); - write(*,*) ' airTemperatureAt2M->reference:',iVal + ! Get the element's width (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->width', iVal); + write (*, *) ' airTemperatureAt2M->width:', iVal - ! Get the element's width (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->width',iVal); - write(*,*) ' airTemperatureAt2M->width:',iVal + ! ------------------------------------------------------------------- + ! The 2m temperature data element in this message has an associated + ! field: percentConfidence. Its value and attributes can be accessed + ! in a similar manner as was shown above for 2m temperature. + ! ------------------------------------------------------------------- - ! ------------------------------------------------------------------- - ! The 2m temperature data element in this message has an associated - ! field: percentConfidence. Its value and attributes can be accessed - ! in a similar manner as was shown above for 2m temperature. - ! ------------------------------------------------------------------- + ! Get the element's value as as real + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence', conf); + write (*, *) ' airTemperatureAt2M->percentConfidence:', conf - ! Get the element's value as as real - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence',conf); - write(*,*) ' airTemperatureAt2M->percentConfidence:', conf + ! Get the element's code (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->code', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->code:', iVal - ! Get the element's code (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->code',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->code:',iVal + ! Get the element's units (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->units', confUnits) + write (*, *) ' airTemperatureAt2M->percentConfidence->units:', confUnits - ! Get the element's units (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->units',confUnits) - write(*,*) ' airTemperatureAt2M->percentConfidence->units:',confUnits + ! Get the element's scale (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->scale', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->code:', iVal - ! Get the element's scale (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->scale',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->code:',iVal + ! Get the element's reference (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->reference', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->reference:', iVal - ! Get the element's reference (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->reference',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->reference:',iVal + ! Get the element's width (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->width', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->width:', iVal - ! Get the element's width (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->width',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->width:',iVal + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_attributes diff --git a/examples/F90/bufr_clone.f90 b/examples/F90/bufr_clone.f90 index a8567453d..1dc231d7b 100644 --- a/examples/F90/bufr_clone.f90 +++ b/examples/F90/bufr_clone.f90 @@ -13,45 +13,45 @@ ! ! program bufr_clone - use eccodes - implicit none - integer :: i,iret - integer :: infile,outfile - integer :: ibufr_in - integer :: ibufr_out + use eccodes + implicit none + integer :: i, iret + integer :: infile, outfile + integer :: ibufr_in + integer :: ibufr_out - ! Open source file - call codes_open_file(infile,'../../data/bufr/syno_multi.bufr','r') + ! Open source file + call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r') - ! Open target file - call codes_open_file(outfile,'bufr_clone_test_f.clone.bufr','w') + ! Open target file + call codes_open_file(outfile, 'bufr_clone_test_f.clone.bufr', 'w') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(infile,ibufr_in,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(infile, ibufr_in, iret) - ! Create several clones of this message and alter them - ! in different ways - do i=1,3 + ! Create several clones of this message and alter them + ! in different ways + do i = 1, 3 - ! Clone the current handle - call codes_clone(ibufr_in, ibufr_out) + ! Clone the current handle + call codes_clone(ibufr_in, ibufr_out) - ! This is the place where you may wish to modify the clone - ! E.g. we change the bufrHeaderCentre - call codes_set(ibufr_out,'bufrHeaderCentre',222) + ! This is the place where you may wish to modify the clone + ! E.g. we change the bufrHeaderCentre + call codes_set(ibufr_out, 'bufrHeaderCentre', 222) - ! Write cloned messages to a file - call codes_write(ibufr_out,outfile) + ! Write cloned messages to a file + call codes_write(ibufr_out, outfile) - ! Release the clone's handle - call codes_release(ibufr_out) - end do + ! Release the clone's handle + call codes_release(ibufr_out) + end do - ! Release the original handle - call codes_release(ibufr_in) + ! Release the original handle + call codes_release(ibufr_in) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) end program bufr_clone diff --git a/examples/F90/bufr_copy_data.f90 b/examples/F90/bufr_copy_data.f90 index e45e8fae8..66565fed4 100644 --- a/examples/F90/bufr_copy_data.f90 +++ b/examples/F90/bufr_copy_data.f90 @@ -15,72 +15,72 @@ ! program bufr_encode - use eccodes - implicit none - integer :: iret - integer :: outfile - integer :: ifile - integer :: ibufr - integer :: ibufrin - integer(kind=4), dimension(:), allocatable :: ivalues - integer, parameter :: max_strsize = 200 - character(len=max_strsize) :: infile_name - character(len=max_strsize) :: outfile_name + use eccodes + implicit none + integer :: iret + integer :: outfile + integer :: ifile + integer :: ibufr + integer :: ibufrin + integer(kind=4), dimension(:), allocatable :: ivalues + integer, parameter :: max_strsize = 200 + character(len=max_strsize) :: infile_name + character(len=max_strsize) :: outfile_name - call codes_bufr_new_from_samples(ibufr,'BUFR3',iret) - call getarg(1, infile_name) - call getarg(2, outfile_name) - call codes_open_file(ifile, infile_name, 'r') - call codes_bufr_new_from_file(ifile, ibufrin) + call codes_bufr_new_from_samples(ibufr, 'BUFR3', iret) + call getarg(1, infile_name) + call getarg(2, outfile_name) + call codes_open_file(ifile, infile_name, 'r') + call codes_bufr_new_from_file(ifile, ibufrin) - if (iret/=CODES_SUCCESS) then - print *,'ERROR creating BUFR from BUFR3' - stop 1 - endif - if(allocated(ivalues)) deallocate(ivalues) - allocate(ivalues(69)) - ivalues=(/ & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 0 /) - call codes_set(ibufr,'inputDataPresentIndicator',ivalues) - call codes_set(ibufr,'edition',3) - call codes_set(ibufr,'masterTableNumber',0) - call codes_set(ibufr,'bufrHeaderSubCentre',0) - call codes_set(ibufr,'bufrHeaderCentre',98) - call codes_set(ibufr,'updateSequenceNumber',1) - call codes_set(ibufr,'dataCategory',0) - call codes_set(ibufr,'dataSubCategory',140) - call codes_set(ibufr,'masterTablesVersionNumber',13) - call codes_set(ibufr,'localTablesVersionNumber',1) - call codes_set(ibufr,'typicalYearOfCentury',15) - call codes_set(ibufr,'typicalMonth',5) - call codes_set(ibufr,'typicalDay',4) - call codes_set(ibufr,'typicalHour',9) - call codes_set(ibufr,'typicalMinute',30) - call codes_set(ibufr,'numberOfSubsets',1) - call codes_set(ibufr,'observedData',1) - call codes_set(ibufr,'compressedData',0) - if(allocated(ivalues)) deallocate(ivalues) - allocate(ivalues(43)) - ivalues=(/ & - 307011,7006,10004,222000,101023,31031,1031,1032,101023,33007, & - 225000,236000,101023,31031,1031,1032,8024,101001,225255,225000, & - 236000,101023,31031,1031,1032,8024,101001,225255, & - 1063,2001,4001,4002,4003,4004,4005,5002, & - 6002,7001,7006,11001,11016,11017,11002 /) - call codes_set(ibufr,'unexpandedDescriptors',ivalues) + if (iret /= CODES_SUCCESS) then + print *, 'ERROR creating BUFR from BUFR3' + stop 1 + end if + if (allocated(ivalues)) deallocate (ivalues) + allocate (ivalues(69)) + ivalues = (/ & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 0/) + call codes_set(ibufr, 'inputDataPresentIndicator', ivalues) + call codes_set(ibufr, 'edition', 3) + call codes_set(ibufr, 'masterTableNumber', 0) + call codes_set(ibufr, 'bufrHeaderSubCentre', 0) + call codes_set(ibufr, 'bufrHeaderCentre', 98) + call codes_set(ibufr, 'updateSequenceNumber', 1) + call codes_set(ibufr, 'dataCategory', 0) + call codes_set(ibufr, 'dataSubCategory', 140) + call codes_set(ibufr, 'masterTablesVersionNumber', 13) + call codes_set(ibufr, 'localTablesVersionNumber', 1) + call codes_set(ibufr, 'typicalYearOfCentury', 15) + call codes_set(ibufr, 'typicalMonth', 5) + call codes_set(ibufr, 'typicalDay', 4) + call codes_set(ibufr, 'typicalHour', 9) + call codes_set(ibufr, 'typicalMinute', 30) + call codes_set(ibufr, 'numberOfSubsets', 1) + call codes_set(ibufr, 'observedData', 1) + call codes_set(ibufr, 'compressedData', 0) + if (allocated(ivalues)) deallocate (ivalues) + allocate (ivalues(43)) + ivalues = (/ & + 307011, 7006, 10004, 222000, 101023, 31031, 1031, 1032, 101023, 33007, & + 225000, 236000, 101023, 31031, 1031, 1032, 8024, 101001, 225255, 225000, & + 236000, 101023, 31031, 1031, 1032, 8024, 101001, 225255, & + 1063, 2001, 4001, 4002, 4003, 4004, 4005, 5002, & + 6002, 7001, 7006, 11001, 11016, 11017, 11002/) + call codes_set(ibufr, 'unexpandedDescriptors', ivalues) - call codes_set(ibufrin,'unpack',1) + call codes_set(ibufrin, 'unpack', 1) - call codes_bufr_copy_data(ibufrin, ibufr) + call codes_bufr_copy_data(ibufrin, ibufr) - call codes_open_file(outfile,outfile_name,'w') - call codes_write(ibufr,outfile) - call codes_close_file(outfile) - call codes_release(ibufr) + call codes_open_file(outfile, outfile_name, 'w') + call codes_write(ibufr, outfile) + call codes_close_file(outfile) + call codes_release(ibufr) end program bufr_encode diff --git a/examples/F90/bufr_copy_keys.f90 b/examples/F90/bufr_copy_keys.f90 index 119b08505..bbb679045 100644 --- a/examples/F90/bufr_copy_keys.f90 +++ b/examples/F90/bufr_copy_keys.f90 @@ -9,26 +9,26 @@ ! Description: how to copy a BUFR key from a message to another. ! program bufr_copy_keys - use eccodes - implicit none - integer :: file1, file2, file3 - integer :: ibufr1,ibufr2,ibufr3 + use eccodes + implicit none + integer :: file1, file2, file3 + integer :: ibufr1, ibufr2, ibufr3 - call codes_open_file(file1, '../../data/bufr/PraticaTemp.bufr', 'r') - call codes_open_file(file2, '../../data/bufr/aaen_55.bufr', 'r') - call codes_open_file(file3, 'out.bufr_copy_keys_test_f.bufr', 'w') + call codes_open_file(file1, '../../data/bufr/PraticaTemp.bufr', 'r') + call codes_open_file(file2, '../../data/bufr/aaen_55.bufr', 'r') + call codes_open_file(file3, 'out.bufr_copy_keys_test_f.bufr', 'w') - call codes_bufr_new_from_file(file1, ibufr1) - call codes_bufr_new_from_file(file2, ibufr2) + call codes_bufr_new_from_file(file1, ibufr1) + call codes_bufr_new_from_file(file2, ibufr2) - call codes_clone(ibufr2, ibufr3) + call codes_clone(ibufr2, ibufr3) - call codes_copy_key(ibufr1, 'bufrHeaderCentre', ibufr3) + call codes_copy_key(ibufr1, 'bufrHeaderCentre', ibufr3) - call codes_write(ibufr3, file3) + call codes_write(ibufr3, file3) - call codes_close_file(file1) - call codes_close_file(file2) - call codes_close_file(file3) + call codes_close_file(file1) + call codes_close_file(file2) + call codes_close_file(file3) end program bufr_copy_keys diff --git a/examples/F90/bufr_copy_message.f90 b/examples/F90/bufr_copy_message.f90 index 4c49fc50f..9c058aa60 100644 --- a/examples/F90/bufr_copy_message.f90 +++ b/examples/F90/bufr_copy_message.f90 @@ -11,43 +11,43 @@ ! ! program copy - use eccodes - implicit none - integer :: err, sub_centre - integer(kind=kindOfSize) :: byte_size - integer :: infile,outfile - integer :: ibufr_in - integer :: ibufr_out - character(len=1), dimension(:), allocatable :: message - character(len=32) :: product_kind + use eccodes + implicit none + integer :: err, sub_centre + integer(kind=kindOfSize) :: byte_size + integer :: infile, outfile + integer :: ibufr_in + integer :: ibufr_out + character(len=1), dimension(:), allocatable :: message + character(len=32) :: product_kind - call codes_open_file(infile,'../../data/bufr/syno_1.bufr', 'r') - call codes_open_file(outfile,'out.copy.bufr', 'w') + call codes_open_file(infile, '../../data/bufr/syno_1.bufr', 'r') + call codes_open_file(outfile, 'out.copy.bufr', 'w') - ! A new BUFR message is loaded from file, - ! ibufr_in is the BUFR id to be used in subsequent calls - call codes_bufr_new_from_file(infile, ibufr_in) + ! A new BUFR message is loaded from file, + ! ibufr_in is the BUFR id to be used in subsequent calls + call codes_bufr_new_from_file(infile, ibufr_in) - call codes_get_message_size(ibufr_in, byte_size) - allocate(message(byte_size), stat=err) + call codes_get_message_size(ibufr_in, byte_size) + allocate (message(byte_size), stat=err) - call codes_copy_message(ibufr_in, message) + call codes_copy_message(ibufr_in, message) - call codes_new_from_message(ibufr_out, message) + call codes_new_from_message(ibufr_out, message) - call codes_get(ibufr_out, 'kindOfProduct', product_kind) - write(*,*) 'kindOfProduct=',product_kind + call codes_get(ibufr_out, 'kindOfProduct', product_kind) + write (*, *) 'kindOfProduct=', product_kind - sub_centre=80 - call codes_set(ibufr_out,'bufrHeaderSubCentre', sub_centre) + sub_centre = 80 + call codes_set(ibufr_out, 'bufrHeaderSubCentre', sub_centre) - ! Write message to a file - call codes_write(ibufr_out, outfile) + ! Write message to a file + call codes_write(ibufr_out, outfile) - call codes_release(ibufr_out) - call codes_release(ibufr_in) - call codes_close_file(infile) - call codes_close_file(outfile) - deallocate(message) + call codes_release(ibufr_out) + call codes_release(ibufr_in) + call codes_close_file(infile) + call codes_close_file(outfile) + deallocate (message) end program copy diff --git a/examples/F90/bufr_expanded.f90 b/examples/F90/bufr_expanded.f90 index 8176b20b4..5bc4c0177 100644 --- a/examples/F90/bufr_expanded.f90 +++ b/examples/F90/bufr_expanded.f90 @@ -13,53 +13,52 @@ ! ! program bufr_expanded -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i -integer :: count=0 -integer(kind=4) :: numberOfValues -real(kind=8), dimension(:), allocatable :: values + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i + integer :: count = 0 + integer(kind=4) :: numberOfValues + real(kind=8), dimension(:), allocatable :: values - call codes_open_file(ifile,'../../data/bufr/syno_1.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_1.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! Get the expanded data values + call codes_get(ibufr, 'numericValues', values) - ! Get the expanded data values - call codes_get(ibufr,'numericValues',values) + numberOfValues = size(values) - numberOfValues=size(values) + do i = 1, numberOfValues + write (*, *) ' ', i, values(i) + end do - do i=1,numberOfValues - write(*,*) ' ',i,values(i) - enddo + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! Free array + deallocate (values) - ! Free array - deallocate(values) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_expanded diff --git a/examples/F90/bufr_get_keys.f90 b/examples/F90/bufr_get_keys.f90 index a391c3fd0..14b5d8406 100644 --- a/examples/F90/bufr_get_keys.f90 +++ b/examples/F90/bufr_get_keys.f90 @@ -13,86 +13,85 @@ ! ! program bufr_get_keys -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i, count=0 -integer(kind=4) :: blockNumber,stationNumber -real(kind=8) :: t2m -integer(kind=4), dimension(:), allocatable :: descriptors -real(kind=8), dimension(:), allocatable :: values -character(len=9) :: typicalDate + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4) :: blockNumber, stationNumber + real(kind=8) :: t2m + integer(kind=4), dimension(:), allocatable :: descriptors + real(kind=8), dimension(:), allocatable :: values + character(len=9) :: typicalDate - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! Get as character + call codes_get(ibufr, 'typicalDate', typicalDate) + write (*, *) ' typicalDate:', typicalDate - ! Get as character - call codes_get(ibufr,'typicalDate',typicalDate) - write(*,*) ' typicalDate:',typicalDate + ! Get as integer + call codes_get(ibufr, 'blockNumber', blockNumber); + write (*, *) ' blockNumber:', blockNumber - ! Get as integer - call codes_get(ibufr,'blockNumber',blockNumber); - write(*,*) ' blockNumber:',blockNumber + ! Get as integer + call codes_get(ibufr, 'stationNumber', stationNumber); + write (*, *) ' stationNumber:', stationNumber - ! Get as integer - call codes_get(ibufr,'stationNumber',stationNumber); - write(*,*) ' stationNumber:',stationNumber + ! get as real + call codes_get(ibufr, 'airTemperatureAt2M', t2m); + write (*, *) ' airTemperatureAt2M:', t2m - ! get as real - call codes_get(ibufr,'airTemperatureAt2M',t2m); - write(*,*) ' airTemperatureAt2M:',t2m + ! ---- array of integer ---------------- - ! ---- array of integer ---------------- + ! get the expanded descriptors + call codes_get(ibufr, 'bufrdcExpandedDescriptors', descriptors) - ! get the expanded descriptors - call codes_get(ibufr,'bufrdcExpandedDescriptors',descriptors) + do i = 1, size(descriptors) + write (*, *) ' ', i, descriptors(i) + end do - do i=1,size(descriptors) - write(*,*) ' ',i,descriptors(i) - enddo + ! ---- array of real ---------------- - ! ---- array of real ---------------- + ! Get the expanded data values + call codes_get(ibufr, 'numericValues', values) - ! Get the expanded data values - call codes_get(ibufr,'numericValues',values) + do i = 1, size(values) + write (*, *) ' ', i, values(i) + end do - do i=1,size(values) - write(*,*) ' ',i,values(i) - enddo + ! Get as character + call codes_get(ibufr, 'typicalDate', typicalDate) + write (*, *) ' typicalDate:', typicalDate - ! Get as character - call codes_get(ibufr,'typicalDate',typicalDate) - write(*,*) ' typicalDate:',typicalDate + ! Free arrays + deallocate (values) + deallocate (descriptors) - ! Free arrays - deallocate(values) - deallocate(descriptors) + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_get_keys diff --git a/examples/F90/bufr_get_string_array.f90 b/examples/F90/bufr_get_string_array.f90 index b5ce5549a..ff5995ade 100644 --- a/examples/F90/bufr_get_string_array.f90 +++ b/examples/F90/bufr_get_string_array.f90 @@ -12,53 +12,53 @@ ! Description: how to get an array of strings from a BUFR message. program bufr_get_string_array - use eccodes - implicit none - integer :: ifile - integer :: iret,i,n - integer :: ibufr - integer :: strsize - integer, parameter :: max_strsize = 20 - character(len=max_strsize) , dimension(:),allocatable :: stationOrSiteName + use eccodes + implicit none + integer :: ifile + integer :: iret, i, n + integer :: ibufr + integer :: strsize + integer, parameter :: max_strsize = 20 + character(len=max_strsize), dimension(:), allocatable :: stationOrSiteName - call codes_open_file(ifile,'../../data/bufr/pgps_110.bufr','r') + call codes_open_file(ifile, '../../data/bufr/pgps_110.bufr', 'r') - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Unpack the data values - call codes_set(ibufr,'unpack',1) + ! Unpack the data values + call codes_set(ibufr, 'unpack', 1) - ! Get the width of the strings which is the same for all of them - call codes_get(ibufr,'stationOrSiteName->width',strsize) + ! Get the width of the strings which is the same for all of them + call codes_get(ibufr, 'stationOrSiteName->width', strsize) - ! The width is given in bits - strsize=strsize/8 + ! The width is given in bits + strsize = strsize/8 - ! max_strsize has to be set to a value >= to the size of the strings that we are getting - ! back from the call to codes_get_string_array - if (strsize > max_strsize) then - print *,'stationOrSiteName array dimension is ',max_strsize,' and should be ',strsize - call exit(1) - end if + ! max_strsize has to be set to a value >= to the size of the strings that we are getting + ! back from the call to codes_get_string_array + if (strsize > max_strsize) then + print *, 'stationOrSiteName array dimension is ', max_strsize, ' and should be ', strsize + call exit(1) + end if - ! Allocating the array of strings to be passed to codes_get_string_array is mandatory - call codes_get_size(ibufr,'stationOrSiteName',n) - allocate(stationOrSiteName(n)) + ! Allocating the array of strings to be passed to codes_get_string_array is mandatory + call codes_get_size(ibufr, 'stationOrSiteName', n) + allocate (stationOrSiteName(n)) - ! Passing an array of strings stationOrSiteName which must be allocated beforehand - call codes_get_string_array(ibufr,'stationOrSiteName',stationOrSiteName) - do i=1,n - write(*,'(A)')trim(stationOrSiteName(i)) - end do + ! Passing an array of strings stationOrSiteName which must be allocated beforehand + call codes_get_string_array(ibufr, 'stationOrSiteName', stationOrSiteName) + do i = 1, n + write (*, '(A)') trim(stationOrSiteName(i)) + end do - ! Remember to deallocate - deallocate(stationOrSiteName) + ! Remember to deallocate + deallocate (stationOrSiteName) - ! Release memory associated with bufr handle - ! ibufr won't be accessible after this - call codes_release(ibufr) + ! Release memory associated with bufr handle + ! ibufr won't be accessible after this + call codes_release(ibufr) - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_get_string_array diff --git a/examples/F90/bufr_keys_iterator.f90 b/examples/F90/bufr_keys_iterator.f90 index 94d98ee3b..888c986fd 100644 --- a/examples/F90/bufr_keys_iterator.f90 +++ b/examples/F90/bufr_keys_iterator.f90 @@ -15,65 +15,64 @@ ! keys in a BUFR message. ! program bufr_keys_iterator -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -character(len=256) :: key -integer :: kiter + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + character(len=256) :: key + integer :: kiter - call codes_open_file(ifile,'../../data/bufr/syno_1.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_1.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret /= CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! Create BUFR keys iterator + call codes_bufr_keys_iterator_new(ibufr, kiter, iret) - ! Create BUFR keys iterator - call codes_bufr_keys_iterator_new(ibufr,kiter,iret) + if (iret .ne. 0) then + write (*, *) 'ERROR: Unable to create BUFR keys iterator' + call exit(1) + end if - if (iret .ne. 0) then - write(*,*) 'ERROR: Unable to create BUFR keys iterator' - call exit(1) - end if + ! Get first key + call codes_bufr_keys_iterator_next(kiter, iret) - ! Get first key - call codes_bufr_keys_iterator_next(kiter, iret) + ! Loop over keys + do while (iret == CODES_SUCCESS) + ! Print key name + call codes_bufr_keys_iterator_get_name(kiter, key) + write (*, *) ' ', trim(key) - ! Loop over keys - do while (iret == CODES_SUCCESS) - ! Print key name - call codes_bufr_keys_iterator_get_name(kiter,key) - write(*,*) ' ',trim(key) + ! Get next key + call codes_bufr_keys_iterator_next(kiter, iret) + end do - ! Get next key - call codes_bufr_keys_iterator_next(kiter, iret) - end do + ! Delete key iterator + call codes_bufr_keys_iterator_delete(kiter) - ! Delete key iterator - call codes_bufr_keys_iterator_delete(kiter) + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_keys_iterator diff --git a/examples/F90/bufr_read_header.f90 b/examples/F90/bufr_read_header.f90 index f9bcbf0b6..de5d7df08 100644 --- a/examples/F90/bufr_read_header.f90 +++ b/examples/F90/bufr_read_header.f90 @@ -13,63 +13,63 @@ ! ! program bufr_read_header -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -integer(kind=4) :: dataCategory,dataSubCategory,typicalDate -integer(kind=4) :: centre,subcentre -integer(kind=4) :: masterversion,localversion -integer(kind=4) :: numberOfSubsets + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: dataCategory, dataSubCategory, typicalDate + integer(kind=4) :: centre, subcentre + integer(kind=4) :: masterversion, localversion + integer(kind=4) :: numberOfSubsets - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - call codes_get(ibufr,'dataCategory',dataCategory); - write(*,*) ' dataCategory:',dataCategory + call codes_get(ibufr, 'dataCategory', dataCategory); + write (*, *) ' dataCategory:', dataCategory - call codes_get(ibufr,'dataSubCategory',dataSubCategory); - write(*,*) ' dataSubCategory:',dataSubCategory + call codes_get(ibufr, 'dataSubCategory', dataSubCategory); + write (*, *) ' dataSubCategory:', dataSubCategory - call codes_get(ibufr,'typicalDate',typicalDate); - write(*,*) ' typicalDate:',typicalDate + call codes_get(ibufr, 'typicalDate', typicalDate); + write (*, *) ' typicalDate:', typicalDate - call codes_get(ibufr,'bufrHeaderCentre',centre); - write(*,*) ' bufrHeaderCentre:',centre + call codes_get(ibufr, 'bufrHeaderCentre', centre); + write (*, *) ' bufrHeaderCentre:', centre - call codes_get(ibufr,'bufrHeaderSubCentre',subcentre) - write(*,*) ' bufrHeaderSubCentre:',subcentre + call codes_get(ibufr, 'bufrHeaderSubCentre', subcentre) + write (*, *) ' bufrHeaderSubCentre:', subcentre - call codes_get(ibufr,'masterTablesVersionNumber',masterversion) - write(*,*) ' masterTablesVersionNumber:',masterversion + call codes_get(ibufr, 'masterTablesVersionNumber', masterversion) + write (*, *) ' masterTablesVersionNumber:', masterversion - call codes_get(ibufr,'localTablesVersionNumber',localversion) - write(*,*) ' localTablesVersionNumber:',localversion + call codes_get(ibufr, 'localTablesVersionNumber', localversion) + write (*, *) ' localTablesVersionNumber:', localversion - call codes_get(ibufr,'numberOfSubsets',numberOfSubsets) - write(*,*) ' numberOfSubsets:',numberOfSubsets + call codes_get(ibufr, 'numberOfSubsets', numberOfSubsets) + write (*, *) ' numberOfSubsets:', numberOfSubsets - ! Release the bufr message - call codes_release(ibufr) + ! Release the bufr message + call codes_release(ibufr) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - count=count+1 + count = count + 1 - end do + end do - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_read_header diff --git a/examples/F90/bufr_read_scatterometer.f90 b/examples/F90/bufr_read_scatterometer.f90 index 7b27b5be2..c3c314658 100644 --- a/examples/F90/bufr_read_scatterometer.f90 +++ b/examples/F90/bufr_read_scatterometer.f90 @@ -15,90 +15,85 @@ ! below might not work directly for other types of messages than the one used in the ! example. It is advised to use bufr_dump first to understand the structure of these messages. - program bufr_read_scatterometer -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i, count=0 -integer(kind=4) :: numObs,ii -real(kind=8), dimension(:), allocatable :: latVal,lonVal,bscatterVal -real(kind=8), dimension(:), allocatable :: year + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4) :: numObs, ii + real(kind=8), dimension(:), allocatable :: latVal, lonVal, bscatterVal + real(kind=8), dimension(:), allocatable :: year - call codes_open_file(ifile,'../../data/bufr/asca_139.bufr','r') + call codes_open_file(ifile, '../../data/bufr/asca_139.bufr', 'r') - ! The first BUFR message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first BUFR message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,'(A,I3)') 'message: ',count + write (*, '(A,I3)') 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! The BUFR file contains a single message with 2016 subsets in a compressed form. + ! It means each subset has exactly the same structure: they store one location with + ! several beams and one backscatter value in each beam. + ! + ! To print the backScatter values for beamIdentifier=2 from all the subsets + ! we will simply access the key by condition (see below). - ! The BUFR file contains a single message with 2016 subsets in a compressed form. - ! It means each subset has exactly the same structure: they store one location with - ! several beams and one backscatter value in each beam. - ! - ! To print the backScatter values for beamIdentifier=2 from all the subsets - ! we will simply access the key by condition (see below). + ! Read the total number of subsets. + call codes_get(ibufr, 'numberOfSubsets', numObs) - ! Read the total number of subsets. - call codes_get(ibufr,'numberOfSubsets',numObs) + write (*, '(A,I5)') "Number of values:", numObs - write(*,'(A,I5)') "Number of values:",numObs + ! Get latitude (for all the subsets) + call codes_get(ibufr, 'latitude', latVal); + ! Get longitude (for all the subsets) + call codes_get(ibufr, 'longitude', lonVal); + allocate (year(numObs)) + call codes_get(ibufr, 'year', year); + do ii = 1, size(year) + write (*, '(A,I4,A,F8.1)') 'year(', ii, ')=', year(ii) + end do - ! Get latitude (for all the subsets) - call codes_get(ibufr,'latitude',latVal); + ! Get backScatter for beam two. We use an access by condition for this key. + ! (for all the subsets) + call codes_get(ibufr, '/beamIdentifier=2/backscatter', bscatterVal); + ! Check that all arrays are same size + if (size(latVal) /= numObs .or. size(lonVal) /= numObs .or. size(bscatterVal) /= numObs) then + print *, 'inconsistent array dimension' + exit + end if - ! Get longitude (for all the subsets) - call codes_get(ibufr,'longitude',lonVal); + ! Print the values + write (*, *) 'pixel lat lon backscatter' + write (*, *) "--------------------------------------" - allocate(year(numObs)) - call codes_get(ibufr,'year',year); - do ii= 1, size(year) - write(*,'(A,I4,A,F8.1)') 'year(',ii,')=',year(ii) - enddo + do i = 1, numObs + write (*, '(I4,3F10.5)') i, latVal(i), lonVal(i), bscatterVal(i) + end do - ! Get backScatter for beam two. We use an access by condition for this key. - ! (for all the subsets) - call codes_get(ibufr,'/beamIdentifier=2/backscatter',bscatterVal); + ! Free arrays + deallocate (latVal) + deallocate (lonVal) + deallocate (bscatterVal) - ! Check that all arrays are same size - if (size(latVal)/= numObs .or. size(lonVal)/= numObs .or. size(bscatterVal)/= numObs) then - print *,'inconsistent array dimension' - exit - endif + ! Release the bufr message + call codes_release(ibufr) - ! Print the values - write(*,*) 'pixel lat lon backscatter' - write(*,*) "--------------------------------------" + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - do i=1,numObs - write(*,'(I4,3F10.5)') i,latVal(i),lonVal(i),bscatterVal(i) - end do + count = count + 1 - ! Free arrays - deallocate(latVal) - deallocate(lonVal) - deallocate(bscatterVal) + end do - ! Release the bufr message - call codes_release(ibufr) - - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) - - count=count+1 - - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_read_scatterometer diff --git a/examples/F90/bufr_read_synop.f90 b/examples/F90/bufr_read_synop.f90 index 5932c7faa..b88a8eabe 100644 --- a/examples/F90/bufr_read_synop.f90 +++ b/examples/F90/bufr_read_synop.f90 @@ -18,102 +18,102 @@ ! ! program bufr_read_synop -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -integer(kind=4) :: blockNumber,stationNumber -real(kind=8) :: lat,t2m,td2m,ws,wdir -integer(kind=4) :: cloudAmount,cloudBaseHeight,lowCloud,midCloud,highCloud + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: blockNumber, stationNumber + real(kind=8) :: lat, t2m, td2m, ws, wdir + integer(kind=4) :: cloudAmount, cloudBaseHeight, lowCloud, midCloud, highCloud - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1) + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1) - !read and print some data values. This example was written - ! for a SYNOP BUFR file! + !read and print some data values. This example was written + ! for a SYNOP BUFR file! - ! wmo block number - call codes_get(ibufr,'blockNumber',blockNumber) - write(*,*) ' blockNumber:',blockNumber + ! wmo block number + call codes_get(ibufr, 'blockNumber', blockNumber) + write (*, *) ' blockNumber:', blockNumber - ! station number - call codes_get(ibufr,'stationNumber',stationNumber) - write(*,*) ' stationNumber:',stationNumber + ! station number + call codes_get(ibufr, 'stationNumber', stationNumber) + write (*, *) ' stationNumber:', stationNumber - ! location - call codes_get(ibufr,'latitude',lat) - write(*,*) ' latitude:',lat + ! location + call codes_get(ibufr, 'latitude', lat) + write (*, *) ' latitude:', lat - call codes_get(ibufr,'longitude',lat) - write(*,*) ' longitude:',lat + call codes_get(ibufr, 'longitude', lat) + write (*, *) ' longitude:', lat - ! 2m temperature - call codes_get(ibufr,'airTemperatureAt2M',t2m); - write(*,*) ' airTemperatureAt2M:',t2m + ! 2m temperature + call codes_get(ibufr, 'airTemperatureAt2M', t2m); + write (*, *) ' airTemperatureAt2M:', t2m - ! 2m dewpoint temperature - call codes_get(ibufr,'dewpointTemperatureAt2M',td2m); - write(*,*) ' dewpointTemperatureAt2M:',td2m + ! 2m dewpoint temperature + call codes_get(ibufr, 'dewpointTemperatureAt2M', td2m); + write (*, *) ' dewpointTemperatureAt2M:', td2m - ! 10m wind - call codes_get(ibufr,'windSpeedAt10M',ws); - write(*,*) ' windSpeedAt10M:',ws + ! 10m wind + call codes_get(ibufr, 'windSpeedAt10M', ws); + write (*, *) ' windSpeedAt10M:', ws - call codes_get(ibufr,'windDirectionAt10M',wdir); - write(*,*) ' windDirectionAt10M:',wdir + call codes_get(ibufr, 'windDirectionAt10M', wdir); + write (*, *) ' windDirectionAt10M:', wdir - ! The cloud information is stored in several blocks in the - ! SYNOP message and the same key means a different thing in different - ! parts of the message. In this example we will read the first - ! cloud block introduced by the key - ! verticalSignificanceSurfaceObservations=1. - ! We know that this is the first occurrence of the keys we want to - ! read so we will use the # (occurrence) operator accordingly. + ! The cloud information is stored in several blocks in the + ! SYNOP message and the same key means a different thing in different + ! parts of the message. In this example we will read the first + ! cloud block introduced by the key + ! verticalSignificanceSurfaceObservations=1. + ! We know that this is the first occurrence of the keys we want to + ! read so we will use the # (occurrence) operator accordingly. - ! Cloud amount (low and middleclouds) - call codes_get(ibufr,'#1#cloudAmount',cloudAmount) - write(*,*) ' cloudAmount (low and middle):',cloudAmount + ! Cloud amount (low and middleclouds) + call codes_get(ibufr, '#1#cloudAmount', cloudAmount) + write (*, *) ' cloudAmount (low and middle):', cloudAmount - ! Height of cloud base - call codes_get(ibufr,'#1#heightOfBaseOfCloud',cloudBaseHeight) - write(*,*) ' heightOfBaseOfCloud:',cloudBaseHeight + ! Height of cloud base + call codes_get(ibufr, '#1#heightOfBaseOfCloud', cloudBaseHeight) + write (*, *) ' heightOfBaseOfCloud:', cloudBaseHeight - ! Cloud type (low clouds) - call codes_get(ibufr,'#1#cloudType',lowCloud) - write(*,*) ' cloudType (low):',lowCloud + ! Cloud type (low clouds) + call codes_get(ibufr, '#1#cloudType', lowCloud) + write (*, *) ' cloudType (low):', lowCloud - ! Cloud type (middle clouds) - call codes_get(ibufr,'#2#cloudType',midCloud) - write(*,*) ' cloudType (middle):',midCloud + ! Cloud type (middle clouds) + call codes_get(ibufr, '#2#cloudType', midCloud) + write (*, *) ' cloudType (middle):', midCloud - ! Cloud type (high clouds) - call codes_get(ibufr,'#3#cloudType',highCloud) - write(*,*) ' cloudType (high):',highCloud + ! Cloud type (high clouds) + call codes_get(ibufr, '#3#cloudType', highCloud) + write (*, *) ' cloudType (high):', highCloud - ! Release the bufr message - call codes_release(ibufr) + ! Release the bufr message + call codes_release(ibufr) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - count=count+1 + count = count + 1 - end do + end do - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_read_synop diff --git a/examples/F90/bufr_read_temp.f90 b/examples/F90/bufr_read_temp.f90 index 1bd142741..cbbb77164 100644 --- a/examples/F90/bufr_read_temp.f90 +++ b/examples/F90/bufr_read_temp.f90 @@ -16,64 +16,64 @@ ! example. It is advised to use bufr_dump first to understand the structure of these messages. ! program bufr_read_temp - use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: ibufr - integer :: i, count=0 - integer(kind=4),dimension(:), allocatable :: timePeriod,extendedVerticalSoundingSignificance - integer(kind=4) :: blockNumber,stationNumber - real(kind=8),dimension(:), allocatable :: pressure,airTemperature,dewpointTemperature - real(kind=8),dimension(:), allocatable :: geopotentialHeight,latitudeDisplacement,longitudeDisplacement - real(kind=8),dimension(:), allocatable :: windDirection,windSpeed + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4), dimension(:), allocatable :: timePeriod, extendedVerticalSoundingSignificance + integer(kind=4) :: blockNumber, stationNumber + real(kind=8), dimension(:), allocatable :: pressure, airTemperature, dewpointTemperature + real(kind=8), dimension(:), allocatable :: geopotentialHeight, latitudeDisplacement, longitudeDisplacement + real(kind=8), dimension(:), allocatable :: windDirection, windSpeed - call codes_open_file(ifile,'../../data/bufr/PraticaTemp.bufr','r') + call codes_open_file(ifile, '../../data/bufr/PraticaTemp.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) - do while (iret/=CODES_END_OF_FILE) - write(*,*) 'message: ',count - call codes_set(ibufr,'unpack',1) - call codes_get(ibufr,'timePeriod',timePeriod) - call codes_get(ibufr,'pressure',pressure) - call codes_get(ibufr,'extendedVerticalSoundingSignificance',extendedVerticalSoundingSignificance) - call codes_get(ibufr,'nonCoordinateGeopotentialHeight',geopotentialHeight) - call codes_get(ibufr,'latitudeDisplacement',latitudeDisplacement) - call codes_get(ibufr,'longitudeDisplacement',longitudeDisplacement) - call codes_get(ibufr,'airTemperature',airTemperature) - call codes_get(ibufr,'dewpointTemperature',dewpointTemperature) - call codes_get(ibufr,'windDirection',windDirection) - call codes_get(ibufr,'windSpeed',windSpeed) - call codes_get(ibufr,'blockNumber',blockNumber) - call codes_get(ibufr,'stationNumber',stationNumber) - print *,'station',blockNumber,stationNumber - print *,'timePeriod pressure geopotentialHeight latitudeDisplacement & - &longitudeDisplacement airTemperature windDirection windSpeed significance' - do i=1,size(windSpeed) - write(*,'(I5,6X,F9.1,2X,F9.2,10X,F8.2,14X,F8.2,16X,F8.2,6X,F8.2,4X,F8.2,4X,I0)') timePeriod(i),pressure(i),& - &geopotentialHeight(i),latitudeDisplacement(i),& - &longitudeDisplacement(i),airTemperature(i),windDirection(i),windSpeed(i),extendedVerticalSoundingSignificance(i) - enddo - ! Free arrays - deallocate(timePeriod) - deallocate(pressure) - deallocate(geopotentialHeight) - deallocate(latitudeDisplacement) - deallocate(longitudeDisplacement) - deallocate(airTemperature) - deallocate(dewpointTemperature) - deallocate(windDirection) - deallocate(windSpeed) - deallocate(extendedVerticalSoundingSignificance) - ! Release the bufr message - call codes_release(ibufr) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) - count=count+1 - end do - ! Close file - call codes_close_file(ifile) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) + do while (iret /= CODES_END_OF_FILE) + write (*, *) 'message: ', count + call codes_set(ibufr, 'unpack', 1) + call codes_get(ibufr, 'timePeriod', timePeriod) + call codes_get(ibufr, 'pressure', pressure) + call codes_get(ibufr, 'extendedVerticalSoundingSignificance', extendedVerticalSoundingSignificance) + call codes_get(ibufr, 'nonCoordinateGeopotentialHeight', geopotentialHeight) + call codes_get(ibufr, 'latitudeDisplacement', latitudeDisplacement) + call codes_get(ibufr, 'longitudeDisplacement', longitudeDisplacement) + call codes_get(ibufr, 'airTemperature', airTemperature) + call codes_get(ibufr, 'dewpointTemperature', dewpointTemperature) + call codes_get(ibufr, 'windDirection', windDirection) + call codes_get(ibufr, 'windSpeed', windSpeed) + call codes_get(ibufr, 'blockNumber', blockNumber) + call codes_get(ibufr, 'stationNumber', stationNumber) + print *, 'station', blockNumber, stationNumber + print *, 'timePeriod pressure geopotentialHeight latitudeDisplacement & + &longitudeDisplacement airTemperature windDirection windSpeed significance' + do i = 1, size(windSpeed) + write (*, '(I5,6X,F9.1,2X,F9.2,10X,F8.2,14X,F8.2,16X,F8.2,6X,F8.2,4X,F8.2,4X,I0)') timePeriod(i), pressure(i),& + &geopotentialHeight(i), latitudeDisplacement(i),& + &longitudeDisplacement(i), airTemperature(i), windDirection(i), windSpeed(i), extendedVerticalSoundingSignificance(i) + end do + ! Free arrays + deallocate (timePeriod) + deallocate (pressure) + deallocate (geopotentialHeight) + deallocate (latitudeDisplacement) + deallocate (longitudeDisplacement) + deallocate (airTemperature) + deallocate (dewpointTemperature) + deallocate (windDirection) + deallocate (windSpeed) + deallocate (extendedVerticalSoundingSignificance) + ! Release the bufr message + call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) + count = count + 1 + end do + ! Close file + call codes_close_file(ifile) end program bufr_read_temp diff --git a/examples/F90/bufr_read_tempf.f90 b/examples/F90/bufr_read_tempf.f90 index 8e464e768..5214cf7c2 100644 --- a/examples/F90/bufr_read_tempf.f90 +++ b/examples/F90/bufr_read_tempf.f90 @@ -18,161 +18,160 @@ ! example. It is advised to use bufr_dump first to understand the structure of these messages. ! program bufr_read_temp - use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: ibufr - integer :: i, count=0 - integer :: iflag - integer :: status_id, status_ht, status_time=0, status_p - integer :: status_rsno, status_rssoft, statid_missing - integer(kind=4) :: sizews - integer(kind=4) :: blockNumber,stationNumber - integer(kind=4) :: ymd,hms - logical :: llstdonly = .True. ! Set True to list standard levels only - logical :: llskip - real(kind=8) :: year,month,day,hour,minute,second - real(kind=8) :: htg,htp,htec=0,sondeType - real(kind=8), dimension(:), allocatable :: lat,lon - real(kind=8), dimension(:), allocatable :: timeVal,dlatVal,dlonVal,vssVal - real(kind=8), dimension(:), allocatable :: presVal,zVal,tVal,tdVal,wdirVal,wspVal - character(len=128) :: statid - character(len=16) :: rsnumber - character(len=16) :: rssoftware - character(len=8) :: Note + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer :: iflag + integer :: status_id, status_ht, status_time = 0, status_p + integer :: status_rsno, status_rssoft, statid_missing + integer(kind=4) :: sizews + integer(kind=4) :: blockNumber, stationNumber + integer(kind=4) :: ymd, hms + logical :: llstdonly = .True. ! Set True to list standard levels only + logical :: llskip + real(kind=8) :: year, month, day, hour, minute, second + real(kind=8) :: htg, htp, htec = 0, sondeType + real(kind=8), dimension(:), allocatable :: lat, lon + real(kind=8), dimension(:), allocatable :: timeVal, dlatVal, dlonVal, vssVal + real(kind=8), dimension(:), allocatable :: presVal, zVal, tVal, tdVal, wdirVal, wspVal + character(len=128) :: statid + character(len=16) :: rsnumber + character(len=16) :: rssoftware + character(len=8) :: Note - call codes_open_file(ifile,'../../data/bufr/PraticaTemp.bufr','r') + call codes_open_file(ifile, '../../data/bufr/PraticaTemp.bufr', 'r') - ! the first bufr message is loaded from file - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! the first bufr message is loaded from file + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! do while (iret/=CODES_END_OF_FILE) - do while (iret/=CODES_END_OF_FILE .AND. status_time==CODES_SUCCESS) + ! do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE .AND. status_time == CODES_SUCCESS) - ! we need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! we need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! In our BUFR message verticalSoundingSignificance is always followed by + ! geopotential, airTemperature, dewpointTemperature, + ! windDirection, windSpeed and pressure. + ! - ! In our BUFR message verticalSoundingSignificance is always followed by - ! geopotential, airTemperature, dewpointTemperature, - ! windDirection, windSpeed and pressure. - ! + count = count + 1 + llskip = .False. - count=count+1 - llskip=.False. + ! Metadata: + call codes_get(ibufr, 'shipOrMobileLandStationIdentifier', statid, status_id) + IF (status_id /= CODES_SUCCESS) statid = "UNKNOWN" + call codes_is_missing(ibufr, 'shipOrMobileLandStationIdentifier', statid_missing) + IF (statid_missing == 1) statid = "MISSING" + call codes_get(ibufr, 'blockNumber', blockNumber) + call codes_get(ibufr, 'stationNumber', stationNumber) + call codes_get(ibufr, 'year', year) + call codes_get(ibufr, 'month', month) + call codes_get(ibufr, 'day', day) + call codes_get(ibufr, 'hour', hour) + call codes_get(ibufr, 'minute', minute) + call codes_get(ibufr, 'second', second, status_time) + IF (status_time /= CODES_SUCCESS) second = 0.0 + call codes_get(ibufr, 'latitude', lat) + call codes_get(ibufr, 'longitude', lon) + call codes_get(ibufr, 'heightOfStationGroundAboveMeanSeaLevel', htg, status_ht) + IF (status_ht /= CODES_SUCCESS) htg = -999.0 + call codes_get(ibufr, 'heightOfBarometerAboveMeanSeaLevel', htp, status_ht) + IF (status_ht /= CODES_SUCCESS) htp = -999.0 + call codes_get(ibufr, 'radiosondeType', sondeType) + call codes_get(ibufr, 'heightOfStation', htec, status_ht) ! Height from WMO list (BUFR) + IF (status_ht == CODES_SUCCESS .AND. htg == -999.0) htg = htec + ymd = INT(year)*10000 + INT(month)*100 + INT(day) + hms = INT(hour)*10000 + INT(minute)*100 + INT(second) + call codes_get(ibufr, 'radiosondeSerialNumber', rsnumber, status_rsno) + call codes_get(ibufr, 'softwareVersionNumber', rssoftware, status_rssoft) - ! Metadata: - call codes_get(ibufr,'shipOrMobileLandStationIdentifier',statid,status_id) - IF (status_id /= CODES_SUCCESS) statid = "UNKNOWN" - call codes_is_missing(ibufr,'shipOrMobileLandStationIdentifier',statid_missing) - IF (statid_missing == 1) statid = "MISSING" - call codes_get(ibufr,'blockNumber',blockNumber) - call codes_get(ibufr,'stationNumber',stationNumber) - call codes_get(ibufr,'year',year) - call codes_get(ibufr,'month',month) - call codes_get(ibufr,'day',day) - call codes_get(ibufr,'hour',hour) - call codes_get(ibufr,'minute',minute) - call codes_get(ibufr,'second',second,status_time) - IF (status_time /= CODES_SUCCESS) second = 0.0 - call codes_get(ibufr,'latitude',lat) - call codes_get(ibufr,'longitude',lon) - call codes_get(ibufr,'heightOfStationGroundAboveMeanSeaLevel',htg,status_ht) - IF (status_ht /= CODES_SUCCESS) htg = -999.0 - call codes_get(ibufr,'heightOfBarometerAboveMeanSeaLevel',htp,status_ht) - IF (status_ht /= CODES_SUCCESS) htp = -999.0 - call codes_get(ibufr,'radiosondeType',sondeType) - call codes_get(ibufr,'heightOfStation',htec,status_ht) ! Height from WMO list (BUFR) - IF (status_ht == CODES_SUCCESS .AND. htg == -999.0) htg = htec - ymd = INT(year)*10000+INT(month)*100+INT(day) - hms = INT(hour)*10000+INT(minute)*100+INT(second) - call codes_get(ibufr,'radiosondeSerialNumber',rsnumber,status_rsno) - call codes_get(ibufr,'softwareVersionNumber',rssoftware,status_rssoft) + ! Ascent (skip incomplete reports for now) + call codes_get(ibufr, 'timePeriod', timeVal, status_time) + IF (status_time /= CODES_SUCCESS) THEN + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType) + write (*, '(A)') 'Missing times - skip' + llskip = .True. + END IF + call codes_get(ibufr, 'pressure', presVal, status_p) + IF (status_p /= CODES_SUCCESS) THEN + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType) + write (*, '(A)') 'Missing pressures - skip' + llskip = .True. + END IF + call codes_get(ibufr, 'nonCoordinateGeopotentialHeight', zVal, status_ht) + IF (status_ht /= CODES_SUCCESS) THEN + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType) + write (*, '(A)') 'Missing heights - skip' + llskip = .True. + END IF + ! IF (blockNumber /= 17 .OR. stationNumber /= 196) llskip=.True. ! FIX + ! IF (blockNumber /= 17.0) llskip=.True. ! FIX - ! Ascent (skip incomplete reports for now) - call codes_get(ibufr,'timePeriod',timeVal,status_time) - IF (status_time /= CODES_SUCCESS) THEN - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType) - write(*,'(A)') 'Missing times - skip' - llskip=.True. - ENDIF - call codes_get(ibufr,'pressure',presVal,status_p) - IF (status_p /= CODES_SUCCESS) THEN - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType) - write(*,'(A)') 'Missing pressures - skip' - llskip=.True. - ENDIF - call codes_get(ibufr,'nonCoordinateGeopotentialHeight',zVal,status_ht) - IF (status_ht /= CODES_SUCCESS) THEN - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType) - write(*,'(A)') 'Missing heights - skip' - llskip=.True. - ENDIF - ! IF (blockNumber /= 17 .OR. stationNumber /= 196) llskip=.True. ! FIX - ! IF (blockNumber /= 17.0) llskip=.True. ! FIX + IF (.NOT. llskip) THEN + call codes_get(ibufr, 'latitudeDisplacement', dlatVal) + call codes_get(ibufr, 'longitudeDisplacement', dlonVal) + call codes_get(ibufr, 'extendedVerticalSoundingSignificance', vssVal) + !call codes_get(ibufr,'geopotentialHeight',zVal) + call codes_get(ibufr, 'airTemperature', tVal) + call codes_get(ibufr, 'dewpointTemperature', tdVal) + call codes_get(ibufr, 'windDirection', wdirVal) + call codes_get(ibufr, 'windSpeed', wspVal) - IF (.NOT.llskip) THEN - call codes_get(ibufr,'latitudeDisplacement',dlatVal) - call codes_get(ibufr,'longitudeDisplacement',dlonVal) - call codes_get(ibufr,'extendedVerticalSoundingSignificance',vssVal) - !call codes_get(ibufr,'geopotentialHeight',zVal) - call codes_get(ibufr,'airTemperature',tVal) - call codes_get(ibufr,'dewpointTemperature',tdVal) - call codes_get(ibufr,'windDirection',wdirVal) - call codes_get(ibufr,'windSpeed',wspVal) + ! ---- Array sizes (pressure size can be larger - wind shear levels) + sizews = size(wspVal) - ! ---- Array sizes (pressure size can be larger - wind shear levels) - sizews = size(wspVal) + ! ---- Print the values -------------------------------- + write (*, '(A,A72)') 'Statid: ', statid + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4,I5)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType), sizews + IF (status_ht == CODES_SUCCESS) write (*, '(A,F9.3,F10.3,F7.1)') & + 'WMO list lat, lon, ht: ', lat(1), lon(1), htec + IF (status_rsno == CODES_SUCCESS) write (*, '(A,A,A)') & + 'Radiosonde number/software: ', rsnumber, rssoftware + write (*, '(A)') 'level dtime dlat dlon pressure geopotH airTemp dewPtT windDir windSp signif' + do i = 1, sizews + Note = ' ' + iflag = vssVal(i) + IF (i > 1) THEN + IF (presVal(i) > presVal(i - 1) .OR. zVal(i) < zVal(i - 1) & + .OR. timeVal(i) < timeVal(i - 1)) Note = ' OOO ' + IF ((timeVal(i) - timeVal(i - 1)) > 120) Note = ' tjump ' + IF (ABS(dlatVal(i) - dlatVal(i - 1)) > 0.1 .OR. & + ABS(dlonVal(i) - dlonVal(i - 1)) > 0.1) THEN + Note = ' pjump ' + IF (dlatVal(i) == CODES_MISSING_DOUBLE .OR. & + dlatVal(i - 1) == CODES_MISSING_DOUBLE) Note = ' pmiss ' + END IF + END IF + IF (.NOT. llstdonly .OR. BTEST(iflag, 16)) & + write (*, '(I5,F7.1,2F7.3,F9.1,F8.1,4F8.2,I8,A)') i, timeVal(i), & + dlatVal(i), dlonVal(i), presVal(i), zVal(i), tVal(i), tVal(i) - tdVal(i), & + wdirVal(i), wspVal(i), INT(vssVal(i)), Note + end do - ! ---- Print the values -------------------------------- - write(*,'(A,A72)') 'Statid: ',statid - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4,I5)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType),sizews - IF (status_ht == CODES_SUCCESS) write(*,'(A,F9.3,F10.3,F7.1)') & - 'WMO list lat, lon, ht: ', lat(1),lon(1),htec - IF (status_rsno == CODES_SUCCESS) write(*,'(A,A,A)') & - 'Radiosonde number/software: ', rsnumber, rssoftware - write(*,'(A)') 'level dtime dlat dlon pressure geopotH airTemp dewPtT windDir windSp signif' - do i=1,sizews - Note = ' ' - iflag = vssVal(i) - IF (i > 1) THEN - IF (presVal(i) > presVal(i-1) .OR. zVal(i) < zVal(i-1) & - .OR. timeVal(i) < timeVal(i-1)) Note=' OOO ' - IF ((timeVal(i)-timeVal(i-1))>120) Note=' tjump ' - IF (ABS(dlatVal(i)-dlatVal(i-1))>0.1 .OR. & - ABS(dlonVal(i)-dlonVal(i-1))>0.1) THEN - Note=' pjump ' - IF (dlatVal(i) == CODES_MISSING_DOUBLE .OR. & - dlatVal(i-1) == CODES_MISSING_DOUBLE) Note=' pmiss ' - ENDIF - ENDIF - IF (.NOT.llstdonly .OR. BTEST(iflag,16)) & - write(*,'(I5,F7.1,2F7.3,F9.1,F8.1,4F8.2,I8,A)') i,timeVal(i), & - dlatVal(i),dlonVal(i),presVal(i),zVal(i),tVal(i),tVal(i)-tdVal(i), & - wdirVal(i),wspVal(i),INT(vssVal(i)), Note - end do + ! free arrays + deallocate (dlatVal, dlonVal, vssVal) + deallocate (presVal, zVal, tVal, tdVal, wdirVal, wspVal) + END IF + IF (ALLOCATED(timeVal)) deallocate (timeVal) - ! free arrays - deallocate(dlatVal,dlonVal,vssVal) - deallocate(presVal,zVal,tVal,tdVal,wdirVal,wspVal) - END IF - IF (ALLOCATED(timeVal)) deallocate(timeVal) + ! release the bufr message + call codes_release(ibufr) - ! release the bufr message - call codes_release(ibufr) + ! load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + end do - end do - - ! close file - call codes_close_file(ifile) + ! close file + call codes_close_file(ifile) end program bufr_read_temp diff --git a/examples/F90/bufr_read_tropical_cyclone.f90 b/examples/F90/bufr_read_tropical_cyclone.f90 index b2b1ee512..19e75bb0a 100644 --- a/examples/F90/bufr_read_tropical_cyclone.f90 +++ b/examples/F90/bufr_read_tropical_cyclone.f90 @@ -21,254 +21,254 @@ program bufr_read_tropical_cyclone implicit none integer :: ifile integer :: iret - integer :: ibufr,skipMember + integer :: ibufr, skipMember integer :: significance - integer :: year,month,day,hour,minute - integer :: i,j,k,ierr,count=1 - integer :: rankPosition,rankSignificance,rankPressure,rankWind - integer :: rankPeriod,numberOfPeriods + integer :: year, month, day, hour, minute + integer :: i, j, k, ierr, count = 1 + integer :: rankPosition, rankSignificance, rankPressure, rankWind + integer :: rankPeriod, numberOfPeriods - real(kind=8) :: latitudeCentre,longitudeCentre - real(kind=8), dimension(:), allocatable :: latitudeMaxWind0,longitudeMaxWind0,windMaxWind0 - real(kind=8), dimension(:), allocatable :: latitudeAnalysis,longitudeAnalysis,pressureAnalysis - real(kind=8), dimension(:,:), allocatable :: latitude,longitude,pressure - real(kind=8), dimension(:,:), allocatable :: latitudeWind,longitudeWind,wind - integer(kind=4), dimension(:), allocatable :: memberNumber,period + real(kind=8) :: latitudeCentre, longitudeCentre + real(kind=8), dimension(:), allocatable :: latitudeMaxWind0, longitudeMaxWind0, windMaxWind0 + real(kind=8), dimension(:), allocatable :: latitudeAnalysis, longitudeAnalysis, pressureAnalysis + real(kind=8), dimension(:, :), allocatable :: latitude, longitude, pressure + real(kind=8), dimension(:, :), allocatable :: latitudeWind, longitudeWind, wind + integer(kind=4), dimension(:), allocatable :: memberNumber, period real(kind=8), dimension(:), allocatable :: values integer(kind=4), dimension(:), allocatable :: ivalues - character(len=8) :: rankSignificanceStr,rankPositionStr,rankPressureStr,rankWindStr - character(len=8) :: stormIdentifier,rankPeriodStr + character(len=8) :: rankSignificanceStr, rankPositionStr, rankPressureStr, rankWindStr + character(len=8) :: stormIdentifier, rankPeriodStr - call codes_open_file(ifile,'../../data/bufr/tropical_cyclone.bufr','r') + call codes_open_file(ifile, '../../data/bufr/tropical_cyclone.bufr', 'r') ! The first BUFR message is loaded from file. ! ibufr is the BUFR id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,'(A,I3,A)') '**************** MESSAGE: ',count,' *****************' + write (*, '(A,I3,A)') '**************** MESSAGE: ', count, ' *****************' ! We need to instruct ecCodes to unpack the data values - call codes_set(ibufr,"unpack",1); + call codes_set(ibufr, "unpack", 1); + call codes_get(ibufr, 'year', year); + call codes_get(ibufr, 'month', month); + call codes_get(ibufr, 'day', day); + call codes_get(ibufr, 'hour', hour); + call codes_get(ibufr, 'minute', minute); + write (*, '(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)') 'Date and time: ', day, '.', month, '.', year, ' ', hour, ':', minute - call codes_get(ibufr,'year',year); - call codes_get(ibufr,'month',month); - call codes_get(ibufr,'day',day); - call codes_get(ibufr,'hour',hour); - call codes_get(ibufr,'minute',minute); - write(*,'(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)')'Date and time: ',day,'.',month,'.',year,' ',hour,':',minute - - call codes_get(ibufr,'stormIdentifier',stormIdentifier) - write(*,'(A,A)')'Storm identifier: ',stormIdentifier + call codes_get(ibufr, 'stormIdentifier', stormIdentifier) + write (*, '(A,A)') 'Storm identifier: ', stormIdentifier ! How many different timePeriod in the data structure? - rankPeriod=0 - ierr=0 - do while(ierr==0) - rankPeriod=rankPeriod+1 - write (rankPeriodStr,'(I0)')rankPeriod - call codes_get(ibufr,'#'//trim(rankPeriodStr)//'#timePeriod',period,ierr) - if(allocated(period)) deallocate(period) - enddo + rankPeriod = 0 + ierr = 0 + do while (ierr == 0) + rankPeriod = rankPeriod + 1 + write (rankPeriodStr, '(I0)') rankPeriod + call codes_get(ibufr, '#'//trim(rankPeriodStr)//'#timePeriod', period, ierr) + if (allocated(period)) deallocate (period) + end do ! The numberOfPeriods includes the analysis (period=0) - numberOfPeriods=rankPeriod + numberOfPeriods = rankPeriod - call codes_get(ibufr,'ensembleMemberNumber',memberNumber) + call codes_get(ibufr, 'ensembleMemberNumber', memberNumber) - allocate(latitude(size(memberNumber),numberOfPeriods)) - allocate(longitude(size(memberNumber),numberOfPeriods)) - allocate(pressure(size(memberNumber),numberOfPeriods)) - allocate(latitudeWind(size(memberNumber),numberOfPeriods)) - allocate(longitudeWind(size(memberNumber),numberOfPeriods)) - allocate(wind(size(memberNumber),numberOfPeriods)) - allocate(values(size(memberNumber))) - allocate(period(numberOfPeriods)) - period(1)=0 + allocate (latitude(size(memberNumber), numberOfPeriods)) + allocate (longitude(size(memberNumber), numberOfPeriods)) + allocate (pressure(size(memberNumber), numberOfPeriods)) + allocate (latitudeWind(size(memberNumber), numberOfPeriods)) + allocate (longitudeWind(size(memberNumber), numberOfPeriods)) + allocate (wind(size(memberNumber), numberOfPeriods)) + allocate (values(size(memberNumber))) + allocate (period(numberOfPeriods)) + period(1) = 0 ! Observed Storm Centre - call codes_get(ibufr,'#1#meteorologicalAttributeSignificance',significance); - call codes_get(ibufr,'#1#latitude',latitudeCentre); - call codes_get(ibufr,'#1#longitude',longitudeCentre); - if (significance/=1) then - print *,'ERROR: unexpected #1#meteorologicalAttributeSignificance' + call codes_get(ibufr, '#1#meteorologicalAttributeSignificance', significance); + call codes_get(ibufr, '#1#latitude', latitudeCentre); + call codes_get(ibufr, '#1#longitude', longitudeCentre); + if (significance /= 1) then + print *, 'ERROR: unexpected #1#meteorologicalAttributeSignificance' stop 1 - endif - if (latitudeCentre==CODES_MISSING_DOUBLE .and. longitudeCentre==CODES_MISSING_DOUBLE) then - write(*,'(a)')'Observed storm centre position missing' + end if + if (latitudeCentre == CODES_MISSING_DOUBLE .and. longitudeCentre == CODES_MISSING_DOUBLE) then + write (*, '(a)') 'Observed storm centre position missing' else - write(*,'(A,F8.2,A,F8.2)')'Observed storm centre: latitude=',latitudeCentre,' longitude=',longitudeCentre - endif + write (*, '(A,F8.2,A,F8.2)') 'Observed storm centre: latitude=', latitudeCentre, ' longitude=', longitudeCentre + end if ! Location of storm in perturbed analysis - call codes_get(ibufr,'#2#meteorologicalAttributeSignificance',significance); - call codes_get(ibufr,'#2#latitude',latitudeAnalysis); - call codes_get(ibufr,'#2#longitude',longitudeAnalysis); - call codes_get(ibufr,'#1#pressureReducedToMeanSeaLevel',pressureAnalysis); - if (significance/=4) then - print *,'ERROR: unexpected #2#meteorologicalAttributeSignificance' + call codes_get(ibufr, '#2#meteorologicalAttributeSignificance', significance); + call codes_get(ibufr, '#2#latitude', latitudeAnalysis); + call codes_get(ibufr, '#2#longitude', longitudeAnalysis); + call codes_get(ibufr, '#1#pressureReducedToMeanSeaLevel', pressureAnalysis); + if (significance /= 4) then + print *, 'ERROR: unexpected #2#meteorologicalAttributeSignificance' stop 1 - endif - if (size(latitudeAnalysis)==size(memberNumber)) then - latitude(:,1)=latitudeAnalysis - longitude(:,1)=longitudeAnalysis - pressure(:,1)=pressureAnalysis + end if + if (size(latitudeAnalysis) == size(memberNumber)) then + latitude(:, 1) = latitudeAnalysis + longitude(:, 1) = longitudeAnalysis + pressure(:, 1) = pressureAnalysis else - latitude(:,1)=latitudeAnalysis(1) - longitude(:,1)=longitudeAnalysis(1) - pressure(:,1)=pressureAnalysis(1) - endif + latitude(:, 1) = latitudeAnalysis(1) + longitude(:, 1) = longitudeAnalysis(1) + pressure(:, 1) = pressureAnalysis(1) + end if ! Location of Maximum Wind - call codes_get(ibufr,'#3#meteorologicalAttributeSignificance',significance); - call codes_get(ibufr,'#3#latitude',latitudeMaxWind0); - call codes_get(ibufr,'#3#longitude',longitudeMaxWind0); - if (significance/=3) then - print *,'ERROR: unexpected #3#meteorologicalAttributeSignificance=',significance + call codes_get(ibufr, '#3#meteorologicalAttributeSignificance', significance); + call codes_get(ibufr, '#3#latitude', latitudeMaxWind0); + call codes_get(ibufr, '#3#longitude', longitudeMaxWind0); + if (significance /= 3) then + print *, 'ERROR: unexpected #3#meteorologicalAttributeSignificance=', significance stop 1 - endif - call codes_get(ibufr,'#1#windSpeedAt10M',windMaxWind0); - if (size(latitudeMaxWind0)==size(memberNumber)) then - latitudeWind(:,1)=latitudeMaxWind0 - longitudeWind(:,1)=longitudeMaxWind0 - wind(:,1)=windMaxWind0 + end if + call codes_get(ibufr, '#1#windSpeedAt10M', windMaxWind0); + if (size(latitudeMaxWind0) == size(memberNumber)) then + latitudeWind(:, 1) = latitudeMaxWind0 + longitudeWind(:, 1) = longitudeMaxWind0 + wind(:, 1) = windMaxWind0 else - latitudeWind(:,1)=latitudeMaxWind0(1) - longitudeWind(:,1)=longitudeMaxWind0(1) - wind(:,1)=windMaxWind0(1) - endif + latitudeWind(:, 1) = latitudeMaxWind0(1) + longitudeWind(:, 1) = longitudeMaxWind0(1) + wind(:, 1) = windMaxWind0(1) + end if - rankSignificance=3 - rankPosition=3 - rankPressure=1 - rankWind=1 - rankPeriod=0 + rankSignificance = 3 + rankPosition = 3 + rankPressure = 1 + rankWind = 1 + rankPeriod = 0 ! Loop on all periods excluding analysis period(1)=0 - do i=2,numberOfPeriods + do i = 2, numberOfPeriods - rankPeriod=rankPeriod+1 - write (rankPeriodStr,'(I0)')rankPeriod - call codes_get(ibufr,'#'//trim(rankPeriodStr)//'#timePeriod',ivalues); - do k=1,size(ivalues) - if (ivalues(k)/=CODES_MISSING_LONG) then - period(i)=ivalues(k) + rankPeriod = rankPeriod + 1 + write (rankPeriodStr, '(I0)') rankPeriod + call codes_get(ibufr, '#'//trim(rankPeriodStr)//'#timePeriod', ivalues); + do k = 1, size(ivalues) + if (ivalues(k) /= CODES_MISSING_LONG) then + period(i) = ivalues(k) exit - endif - enddo - deallocate(ivalues) + end if + end do + deallocate (ivalues) ! Location of the storm - rankSignificance=rankSignificance+1 - write (rankSignificanceStr,'(I0)')rankSignificance - call codes_get(ibufr,'#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance',ivalues); - do k=1,size(ivalues) - if (ivalues(k)/=CODES_MISSING_LONG) then - significance=ivalues(k) + rankSignificance = rankSignificance + 1 + write (rankSignificanceStr, '(I0)') rankSignificance + call codes_get(ibufr, '#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance', ivalues); + do k = 1, size(ivalues) + if (ivalues(k) /= CODES_MISSING_LONG) then + significance = ivalues(k) exit - endif - enddo - deallocate(ivalues) + end if + end do + deallocate (ivalues) - rankPosition=rankPosition+1 - write (rankPositionStr,'(I0)')rankPosition - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#latitude',values); - latitude(:,i)=values - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#longitude',values); - longitude(:,i)=values + rankPosition = rankPosition + 1 + write (rankPositionStr, '(I0)') rankPosition + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#latitude', values); + latitude(:, i) = values + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#longitude', values); + longitude(:, i) = values - if (significance==1) then - rankPressure=rankPressure+1 - write (rankPressureStr,'(I0)')rankPressure - call codes_get(ibufr,'#'//trim(rankPressureStr)//'#pressureReducedToMeanSeaLevel',values); - pressure(:,i)=values + if (significance == 1) then + rankPressure = rankPressure + 1 + write (rankPressureStr, '(I0)') rankPressure + call codes_get(ibufr, '#'//trim(rankPressureStr)//'#pressureReducedToMeanSeaLevel', values); + pressure(:, i) = values else - print *,'ERROR: unexpected meteorologicalAttributeSignificance=',significance + print *, 'ERROR: unexpected meteorologicalAttributeSignificance=', significance stop 1 - endif + end if ! Location of maximum wind - rankSignificance=rankSignificance+1 - write (rankSignificanceStr,'(I0)')rankSignificance - call codes_get(ibufr,'#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance',ivalues); - do k=1,size(ivalues) - if (ivalues(k)/=CODES_MISSING_LONG) then - significance=ivalues(k) + rankSignificance = rankSignificance + 1 + write (rankSignificanceStr, '(I0)') rankSignificance + call codes_get(ibufr, '#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance', ivalues); + do k = 1, size(ivalues) + if (ivalues(k) /= CODES_MISSING_LONG) then + significance = ivalues(k) exit - endif - enddo - deallocate(ivalues) + end if + end do + deallocate (ivalues) - rankPosition=rankPosition+1 - write (rankPositionStr,'(I0)')rankPosition - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#latitude',values); - latitudeWind(:,i)=values - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#longitude',values); - longitudeWind(:,i)=values + rankPosition = rankPosition + 1 + write (rankPositionStr, '(I0)') rankPosition + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#latitude', values); + latitudeWind(:, i) = values + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#longitude', values); + longitudeWind(:, i) = values - if (significance==3) then - rankWind=rankWind+1 - write (rankWindStr,'(I0)')rankWind - call codes_get(ibufr,'#'//trim(rankWindStr)//'#windSpeedAt10M',values); - wind(:,i)=values + if (significance == 3) then + rankWind = rankWind + 1 + write (rankWindStr, '(I0)') rankWind + call codes_get(ibufr, '#'//trim(rankWindStr)//'#windSpeedAt10M', values); + wind(:, i) = values else - print *,'ERROR: unexpected meteorologicalAttributeSignificance=,',significance + print *, 'ERROR: unexpected meteorologicalAttributeSignificance=,', significance stop 1 - endif + end if - enddo + end do ! Print the values - do i=1,size(memberNumber) - skipMember=1 - do j=1,size(period) - if (latitude(i,j)/=CODES_MISSING_DOUBLE .OR. latitudeWind(i,j)/=CODES_MISSING_DOUBLE) then - skipMember=0 + do i = 1, size(memberNumber) + skipMember = 1 + do j = 1, size(period) + if (latitude(i, j) /= CODES_MISSING_DOUBLE .OR. latitudeWind(i, j) /= CODES_MISSING_DOUBLE) then + skipMember = 0 exit - endif - enddo - if (skipMember/=1) then + end if + end do + if (skipMember /= 1) then - write(*,'(A,I3)') '== Member ',memberNumber(i) - write(*,*) 'step latitude longitude pressure latitude longitude wind' - do j=1,size(period) - if (latitude(i,j)/=CODES_MISSING_DOUBLE .OR. latitudeWind(i,j)/=CODES_MISSING_DOUBLE) then - write(*,'( I4,2X,F8.2,4X,F8.2,3X,F9.1,2X,F8.2,4X,F8.2,2X,F8.2)') period(j),latitude(i,j),longitude(i,j),pressure(i,j),& - &latitudeWind(i,j),longitudeWind(i,j),wind(i,j) - endif - enddo + write (*, '(A,I3)') '== Member ', memberNumber(i) + write (*, *) 'step latitude longitude pressure latitude longitude wind' + do j = 1, size(period) + if (latitude(i, j) /= CODES_MISSING_DOUBLE .OR. latitudeWind(i, j) /= CODES_MISSING_DOUBLE) then + write (*, '( I4,2X,F8.2,4X,F8.2,3X,F9.1,2X,F8.2,4X,F8.2,2X,F8.2)') & + period(j), latitude(i, j), longitude(i, j), pressure(i, j), & + latitudeWind(i, j), longitudeWind(i, j), wind(i, j) + end if + end do - endif - enddo + end if + end do ! deallocating the arrays is very important ! because the behaviour of the codes_get functions is as follows: ! if the array is not allocated then allocate ! if the array is already allocated only copy the values - deallocate(values) - deallocate(latitude) - deallocate(longitude) - deallocate(pressure) - deallocate(latitudeWind) - deallocate(longitudeWind) - deallocate(wind) - deallocate(period) - deallocate(latitudeAnalysis) - deallocate(longitudeAnalysis) - deallocate(pressureAnalysis) - deallocate(memberNumber) - deallocate(latitudeMaxWind0) - deallocate(longitudeMaxWind0) - deallocate(windMaxWind0) + deallocate (values) + deallocate (latitude) + deallocate (longitude) + deallocate (pressure) + deallocate (latitudeWind) + deallocate (longitudeWind) + deallocate (wind) + deallocate (period) + deallocate (latitudeAnalysis) + deallocate (longitudeAnalysis) + deallocate (pressureAnalysis) + deallocate (memberNumber) + deallocate (latitudeMaxWind0) + deallocate (longitudeMaxWind0) + deallocate (windMaxWind0) ! Release the BUFR message call codes_release(ibufr) ! Load the next BUFR message - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - count=count+1 + count = count + 1 end do diff --git a/examples/F90/bufr_set_keys.f90 b/examples/F90/bufr_set_keys.f90 index a3cc6ac2d..a51e76734 100644 --- a/examples/F90/bufr_set_keys.f90 +++ b/examples/F90/bufr_set_keys.f90 @@ -12,55 +12,55 @@ ! ! program bufr_set_keys - use eccodes - implicit none - integer :: iret - integer :: infile,outfile - integer :: ibufr - integer :: count=0 - integer(kind=4) :: centre, centreNew + use eccodes + implicit none + integer :: iret + integer :: infile, outfile + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: centre, centreNew - ! Open input file - call codes_open_file(infile,'../../data/bufr/syno_multi.bufr','r') + ! Open input file + call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r') - ! Open output file - call codes_open_file(outfile,'bufr_set_keys_test_f.tmp.bufr','w') + ! Open output file + call codes_open_file(outfile, 'bufr_set_keys_test_f.tmp.bufr', 'w') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(infile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(infile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! This is the place where you may wish to modify the message - ! E.g. we change the centre + ! This is the place where you may wish to modify the message + ! E.g. we change the centre - ! Set centre - centre=222 - call codes_set(ibufr,'bufrHeaderCentre',222) - write(*,*) ' set bufrHeaderCentre to:',centre + ! Set centre + centre = 222 + call codes_set(ibufr, 'bufrHeaderCentre', 222) + write (*, *) ' set bufrHeaderCentre to:', centre - ! Check centre's new value - centreNew=0 - call codes_get(ibufr,'bufrHeaderCentre',centreNew) - write(*,*) ' bufrHeaderCentre''s new value:',centreNew + ! Check centre's new value + centreNew = 0 + call codes_get(ibufr, 'bufrHeaderCentre', centreNew) + write (*, *) ' bufrHeaderCentre''s new value:', centreNew - ! Write modified message to a file - call codes_write(ibufr,outfile) + ! Write modified message to a file + call codes_write(ibufr, outfile) - ! Release the handle - call codes_release(ibufr) + ! Release the handle + call codes_release(ibufr) - ! Next message from source - call codes_bufr_new_from_file(infile,ibufr,iret) + ! Next message from source + call codes_bufr_new_from_file(infile, ibufr, iret) - count=count+1 + count = count + 1 - end do + end do - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) end program bufr_set_keys diff --git a/examples/F90/bufr_subset.f90 b/examples/F90/bufr_subset.f90 index d23008fc7..591ffb493 100644 --- a/examples/F90/bufr_subset.f90 +++ b/examples/F90/bufr_subset.f90 @@ -13,66 +13,65 @@ ! ! program bufr_subset -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i, count=0 -integer(kind=4) :: numberOfSubsets -integer(kind=4) :: blockNumber,stationNumber -character(100) :: key + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4) :: numberOfSubsets + integer(kind=4) :: blockNumber, stationNumber + character(100) :: key !real(kind=8) :: t2m - call codes_open_file(ifile,'../../data/bufr/synop_multi_subset.bufr','r') + call codes_open_file(ifile, '../../data/bufr/synop_multi_subset.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,'unpack',1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, 'unpack', 1); + ! Find out the number of subsets + call codes_get(ibufr, 'numberOfSubsets', numberOfSubsets) + write (*, *) ' numberOfSubsets:', numberOfSubsets - ! Find out the number of subsets - call codes_get(ibufr,'numberOfSubsets',numberOfSubsets) - write(*,*) ' numberOfSubsets:',numberOfSubsets + ! Loop over the subsets + do i = 1, numberOfSubsets - ! Loop over the subsets - do i=1,numberOfSubsets +100 format('/subsetNumber=', I5.5, '/blockNumber') + write (key, 100) I + write (*, *) key - 100 format('/subsetNumber=',I5.5,'/blockNumber') - write(key,100) I - write(*,*) key + write (*, *) ' subsetNumber:', i + ! read and print some data values - write(*,*) ' subsetNumber:',i - ! read and print some data values + call codes_get(ibufr, key, blockNumber); + write (*, *) ' blockNumber:', blockNumber - call codes_get(ibufr,key,blockNumber); - write(*,*) ' blockNumber:',blockNumber + write (key, *) '/subsetNumber=', I, '/stationNumber' + call codes_get(ibufr, 'stationNumber', stationNumber); + write (*, *) ' stationNumber:', stationNumber - write(key,*) '/subsetNumber=',I,'/stationNumber' - call codes_get(ibufr,'stationNumber',stationNumber); - write(*,*) ' stationNumber:',stationNumber + end do - end do + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_subset diff --git a/examples/F90/get_fortran.f90 b/examples/F90/get_fortran.f90 index 6a9e53a51..4a1dd27e2 100644 --- a/examples/F90/get_fortran.f90 +++ b/examples/F90/get_fortran.f90 @@ -10,108 +10,108 @@ ! ! program get -use eccodes -implicit none + use eccodes + implicit none - integer :: ifile - integer :: iret - integer :: igrib - integer :: i - real(kind=8) :: latitudeOfFirstPointInDegrees - real(kind=8) :: longitudeOfFirstPointInDegrees - real(kind=8) :: latitudeOfLastPointInDegrees - real(kind=8) :: longitudeOfLastPointInDegrees - real(kind=8) :: jDirectionIncrementInDegrees - real(kind=8) :: iDirectionIncrementInDegrees - integer(kind = 4) :: numberOfPointsAlongAParallel - integer(kind = 4) :: numberOfPointsAlongAMeridian - real(kind=8), dimension(:), allocatable :: values - integer(kind = 4) :: numberOfValues - real(kind=8) :: average + integer :: ifile + integer :: iret + integer :: igrib + integer :: i + real(kind=8) :: latitudeOfFirstPointInDegrees + real(kind=8) :: longitudeOfFirstPointInDegrees + real(kind=8) :: latitudeOfLastPointInDegrees + real(kind=8) :: longitudeOfLastPointInDegrees + real(kind=8) :: jDirectionIncrementInDegrees + real(kind=8) :: iDirectionIncrementInDegrees + integer(kind=4) :: numberOfPointsAlongAParallel + integer(kind=4) :: numberOfPointsAlongAMeridian + real(kind=8), dimension(:), allocatable :: values + integer(kind=4) :: numberOfValues + real(kind=8) :: average - call codes_open_file(ifile, & - '../../data/reduced_latlon_surface.grib1','r') + call codes_open_file(ifile, & + '../../data/reduced_latlon_surface.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib) - ! get as a integer - call codes_get(igrib,'numberOfPointsAlongAParallel', & - numberOfPointsAlongAParallel) - write(*,*) 'numberOfPointsAlongAParallel=', & - numberOfPointsAlongAParallel + ! get as a integer + call codes_get(igrib, 'numberOfPointsAlongAParallel', & + numberOfPointsAlongAParallel) + write (*, *) 'numberOfPointsAlongAParallel=', & + numberOfPointsAlongAParallel - ! get as a integer - call codes_get(igrib,'numberOfPointsAlongAMeridian', & - numberOfPointsAlongAMeridian) - write(*,*) 'numberOfPointsAlongAMeridian=', & - numberOfPointsAlongAMeridian + ! get as a integer + call codes_get(igrib, 'numberOfPointsAlongAMeridian', & + numberOfPointsAlongAMeridian) + write (*, *) 'numberOfPointsAlongAMeridian=', & + numberOfPointsAlongAMeridian - ! get as a real8 - call codes_get(igrib, & - 'latitudeOfFirstGridPointInDegrees', & - latitudeOfFirstPointInDegrees) - write(*,*) 'latitudeOfFirstGridPointInDegrees=', & - latitudeOfFirstPointInDegrees + ! get as a real8 + call codes_get(igrib, & + 'latitudeOfFirstGridPointInDegrees', & + latitudeOfFirstPointInDegrees) + write (*, *) 'latitudeOfFirstGridPointInDegrees=', & + latitudeOfFirstPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'longitudeOfFirstGridPointInDegrees', & - longitudeOfFirstPointInDegrees) - write(*,*) 'longitudeOfFirstGridPointInDegrees=', & + ! get as a real8 + call codes_get(igrib, & + 'longitudeOfFirstGridPointInDegrees', & + longitudeOfFirstPointInDegrees) + write (*, *) 'longitudeOfFirstGridPointInDegrees=', & longitudeOfFirstPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'latitudeOfLastGridPointInDegrees', & - latitudeOfLastPointInDegrees) - write(*,*) 'latitudeOfLastGridPointInDegrees=', & + ! get as a real8 + call codes_get(igrib, & + 'latitudeOfLastGridPointInDegrees', & + latitudeOfLastPointInDegrees) + write (*, *) 'latitudeOfLastGridPointInDegrees=', & latitudeOfLastPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'longitudeOfLastGridPointInDegrees', & - longitudeOfLastPointInDegrees) - write(*,*) 'longitudeOfLastGridPointInDegrees=', & - longitudeOfLastPointInDegrees + ! get as a real8 + call codes_get(igrib, & + 'longitudeOfLastGridPointInDegrees', & + longitudeOfLastPointInDegrees) + write (*, *) 'longitudeOfLastGridPointInDegrees=', & + longitudeOfLastPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'jDirectionIncrementInDegrees', & - jDirectionIncrementInDegrees) - write(*,*) 'jDirectionIncrementInDegrees=', & - jDirectionIncrementInDegrees + ! get as a real8 + call codes_get(igrib, & + 'jDirectionIncrementInDegrees', & + jDirectionIncrementInDegrees) + write (*, *) 'jDirectionIncrementInDegrees=', & + jDirectionIncrementInDegrees - ! get as a real8 - call codes_get(igrib, & - 'iDirectionIncrementInDegrees', & - iDirectionIncrementInDegrees) - write(*,*) 'iDirectionIncrementInDegrees=', & - iDirectionIncrementInDegrees + ! get as a real8 + call codes_get(igrib, & + 'iDirectionIncrementInDegrees', & + iDirectionIncrementInDegrees) + write (*, *) 'iDirectionIncrementInDegrees=', & + iDirectionIncrementInDegrees - ! get the size of the values array - call codes_get_size(igrib,'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + ! get the size of the values array + call codes_get_size(igrib, 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - allocate(values(2*numberOfValues), stat=iret) - ! get data values - print*, size(values) - call codes_get(igrib,'values',values) + allocate (values(2*numberOfValues), stat=iret) + ! get data values + print *, size(values) + call codes_get(igrib, 'values', values) - average = 0 - do i=1,numberOfValues - average = average + values(i); - enddo + average = 0 + do i = 1, numberOfValues + average = average + values(i); + end do - average =average / numberOfValues + average = average/numberOfValues - write(*,*)'There are ',numberOfValues, & - ' average is ',average + write (*, *) 'There are ', numberOfValues, & + ' average is ', average - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(ifile) + call codes_close_file(ifile) - deallocate(values) + deallocate (values) end program get diff --git a/examples/F90/get_product_kind.f90 b/examples/F90/get_product_kind.f90 index f04dd0edb..7907b8a6b 100644 --- a/examples/F90/get_product_kind.f90 +++ b/examples/F90/get_product_kind.f90 @@ -13,54 +13,54 @@ ! and print the kind of product (e.g. GRIB, BUFR etc) ! program get_product_kind - use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: ihandle - integer :: count=0 - integer :: version=0 - character(len=32) :: product_kind - character(len=120) :: infile_name + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ihandle + integer :: count = 0 + integer :: version = 0 + character(len=32) :: product_kind + character(len=120) :: infile_name - call getarg(1, infile_name) - write(*,*) 'infile_name|',infile_name,'|' - call codes_open_file(ifile,infile_name,'r') + call getarg(1, infile_name) + write (*, *) 'infile_name|', infile_name, '|' + call codes_open_file(ifile, infile_name, 'r') - call codes_get_api_version(version) - write(*,*) 'API version: ',version + call codes_get_api_version(version) + write (*, *) 'API version: ', version - write(*,*) 'ecCodes settings: ' - write(*,*) ' ECCODES_POSIX_THREADS: ',ECCODES_SETTINGS_POSIX_THREADS - write(*,*) ' ECCODES_OMP_THREADS: ',ECCODES_SETTINGS_OMP_THREADS - write(*,*) ' ECCODES_SETTINGS_MEMFS: ',ECCODES_SETTINGS_MEMFS - write(*,*) ' ECCODES_SETTINGS_JPEG: ',ECCODES_SETTINGS_JPEG - write(*,*) ' ECCODES_SETTINGS_PNG: ',ECCODES_SETTINGS_PNG - write(*,*) ' ECCODES_SETTINGS_AEC: ',ECCODES_SETTINGS_AEC + write (*, *) 'ecCodes settings: ' + write (*, *) ' ECCODES_POSIX_THREADS: ', ECCODES_SETTINGS_POSIX_THREADS + write (*, *) ' ECCODES_OMP_THREADS: ', ECCODES_SETTINGS_OMP_THREADS + write (*, *) ' ECCODES_SETTINGS_MEMFS: ', ECCODES_SETTINGS_MEMFS + write (*, *) ' ECCODES_SETTINGS_JPEG: ', ECCODES_SETTINGS_JPEG + write (*, *) ' ECCODES_SETTINGS_PNG: ', ECCODES_SETTINGS_PNG + write (*, *) ' ECCODES_SETTINGS_AEC: ', ECCODES_SETTINGS_AEC ! the first message is loaded from file ! ihandle is the message id to be used in subsequent calls - call codes_new_from_file(ifile,ihandle,CODES_PRODUCT_ANY,iret) + call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! get the product kind - call codes_get(ihandle,'kindOfProduct',product_kind) - write(*,*) ' product: ',product_kind + ! get the product kind + call codes_get(ihandle, 'kindOfProduct', product_kind) + write (*, *) ' product: ', product_kind - ! release the message - call codes_release(ihandle) + ! release the message + call codes_release(ihandle) - ! load the next message - call codes_new_from_file(ifile,ihandle,CODES_PRODUCT_ANY,iret) + ! load the next message + call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret) - count=count+1 + count = count + 1 - end do + end do - ! close file - call codes_close_file(ifile) + ! close file + call codes_close_file(ifile) end program get_product_kind diff --git a/examples/F90/grib_clone.f90 b/examples/F90/grib_clone.f90 index cb69e5935..7019a5156 100644 --- a/examples/F90/grib_clone.f90 +++ b/examples/F90/grib_clone.f90 @@ -14,62 +14,62 @@ ! ! program clone - use eccodes - implicit none - integer :: err,i - integer :: nx, ny - integer :: infile,outfile - integer :: igrib_in - integer :: igrib_out - character(len=2) :: step - real(kind=8), dimension(:,:), allocatable :: field2D + use eccodes + implicit none + integer :: err, i + integer :: nx, ny + integer :: infile, outfile + integer :: igrib_in + integer :: igrib_out + character(len=2) :: step + real(kind=8), dimension(:, :), allocatable :: field2D - call codes_open_file(infile,'../../data/constant_field.grib1','r') - call codes_open_file(outfile,'out.clone.grib1','w') + call codes_open_file(infile, '../../data/constant_field.grib1', 'r') + call codes_open_file(outfile, 'out.clone.grib1', 'w') - ! A new GRIB message is loaded from file. - ! igrib is the GRIB id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib_in) + ! A new GRIB message is loaded from file. + ! igrib is the GRIB id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib_in) - call codes_get(igrib_in,'Ni', nx) - call codes_get(igrib_in,'Nj', ny) + call codes_get(igrib_in, 'Ni', nx) + call codes_get(igrib_in, 'Nj', ny) - allocate(field2D(nx,ny),stat=err) + allocate (field2D(nx, ny), stat=err) - if (err .ne. 0) then - print*, 'Failed to allocate ', nx*ny, ' values' - STOP - end if - ! clone the constant field to create 4 new GRIB messages - do i=0,18,6 - call codes_clone(igrib_in, igrib_out) - write(step,'(i2)') i - ! Careful: stepRange is a string (could be 0-6, 12-24, etc.) - ! use adjustl to remove blank from the left. - call codes_set(igrib_out,'stepRange',adjustl(step)) + if (err .ne. 0) then + print *, 'Failed to allocate ', nx*ny, ' values' + STOP + end if + ! clone the constant field to create 4 new GRIB messages + do i = 0, 18, 6 + call codes_clone(igrib_in, igrib_out) + write (step, '(i2)') i + ! Careful: stepRange is a string (could be 0-6, 12-24, etc.) + ! use adjustl to remove blank from the left. + call codes_set(igrib_out, 'stepRange', adjustl(step)) - call generate_field(field2D) + call generate_field(field2D) - ! use pack to create 1D values - call codes_set(igrib_out,'values',pack(field2D, mask=.true.)) + ! use pack to create 1D values + call codes_set(igrib_out, 'values', pack(field2D, mask=.true.)) - ! write cloned messages to a file - call codes_write(igrib_out,outfile) - call codes_release(igrib_out) - end do + ! write cloned messages to a file + call codes_write(igrib_out, outfile) + call codes_release(igrib_out) + end do - call codes_release(igrib_in) - call codes_close_file(infile) - call codes_close_file(outfile) - deallocate(field2D) + call codes_release(igrib_in) + call codes_close_file(infile) + call codes_close_file(outfile) + deallocate (field2D) contains !====================================== -subroutine generate_field(gfield2D) - real(kind=8), dimension(:,:) :: gfield2D + subroutine generate_field(gfield2D) + real(kind=8), dimension(:, :) :: gfield2D - call random_number(gfield2D) -end subroutine generate_field + call random_number(gfield2D) + end subroutine generate_field !====================================== end program clone diff --git a/examples/F90/grib_copy_message.f90 b/examples/F90/grib_copy_message.f90 index 2b7d23035..2abd4a470 100644 --- a/examples/F90/grib_copy_message.f90 +++ b/examples/F90/grib_copy_message.f90 @@ -13,44 +13,43 @@ ! ! program copy - use eccodes - implicit none - integer :: err, centre - integer(kind=kindOfSize) :: byte_size - integer :: infile,outfile - integer :: igrib_in - integer :: igrib_out - character(len=1), dimension(:), allocatable :: message - character(len=32) :: product_kind + use eccodes + implicit none + integer :: err, centre + integer(kind=kindOfSize) :: byte_size + integer :: infile, outfile + integer :: igrib_in + integer :: igrib_out + character(len=1), dimension(:), allocatable :: message + character(len=32) :: product_kind + call codes_open_file(infile, '../../data/constant_field.grib1', 'r') + call codes_open_file(outfile, 'out.copy.grib1', 'w') - call codes_open_file(infile,'../../data/constant_field.grib1','r') - call codes_open_file(outfile,'out.copy.grib1','w') + ! A new GRIB message is loaded from file + ! igrib_in is the GRIB id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib_in) - ! A new GRIB message is loaded from file - ! igrib_in is the GRIB id to be used in subsequent calls - call codes_grib_new_from_file(infile, igrib_in) + call codes_get_message_size(igrib_in, byte_size) + allocate (message(byte_size), stat=err) - call codes_get_message_size(igrib_in, byte_size) - allocate(message(byte_size), stat=err) + call codes_copy_message(igrib_in, message) - call codes_copy_message(igrib_in, message) + call codes_new_from_message(igrib_out, message) - call codes_new_from_message(igrib_out, message) + call codes_get(igrib_out, 'kindOfProduct', product_kind) + write (*, *) 'kindOfProduct=', product_kind - call codes_get(igrib_out, 'kindOfProduct', product_kind) - write(*,*) 'kindOfProduct=',product_kind + centre = 80 + call codes_set(igrib_out, 'centre', centre) - centre=80 - call codes_set(igrib_out, 'centre', centre) + ! Write message to a file + call codes_write(igrib_out, outfile) - ! Write message to a file - call codes_write(igrib_out, outfile) - - call codes_release(igrib_out) - call codes_release(igrib_in) - call codes_close_file(infile) - call codes_close_file(outfile) - deallocate(message) + call codes_release(igrib_out) + call codes_release(igrib_in) + call codes_close_file(infile) + call codes_close_file(outfile) + deallocate (message) end program copy diff --git a/examples/F90/grib_copy_namespace.f90 b/examples/F90/grib_copy_namespace.f90 index 440f22dcd..854281f8a 100644 --- a/examples/F90/grib_copy_namespace.f90 +++ b/examples/F90/grib_copy_namespace.f90 @@ -11,26 +11,26 @@ ! ! program copy_namespace - use eccodes - implicit none - integer :: file1, file2, file3 - integer :: igrib1,igrib2,igrib3 + use eccodes + implicit none + integer :: file1, file2, file3 + integer :: igrib1, igrib2, igrib3 - call codes_open_file(file1, '../../data/reduced_latlon_surface.grib2', 'r') - call codes_open_file(file2, '../../data/regular_latlon_surface.grib1', 'r') - call codes_open_file(file3, 'out.grib_copy_namespace.grib','w') + call codes_open_file(file1, '../../data/reduced_latlon_surface.grib2', 'r') + call codes_open_file(file2, '../../data/regular_latlon_surface.grib1', 'r') + call codes_open_file(file3, 'out.grib_copy_namespace.grib', 'w') - call codes_grib_new_from_file(file1, igrib1) - call codes_grib_new_from_file(file2, igrib2) + call codes_grib_new_from_file(file1, igrib1) + call codes_grib_new_from_file(file2, igrib2) - call codes_clone(igrib2, igrib3) + call codes_clone(igrib2, igrib3) - call codes_copy_namespace(igrib1, 'geography', igrib3) + call codes_copy_namespace(igrib1, 'geography', igrib3) call codes_write(igrib3, file3) - call codes_close_file(file1) - call codes_close_file(file2) - call codes_close_file(file3) + call codes_close_file(file1) + call codes_close_file(file2) + call codes_close_file(file3) end program copy_namespace diff --git a/examples/F90/grib_count_messages.f90 b/examples/F90/grib_count_messages.f90 index de63eba57..fddaac45a 100644 --- a/examples/F90/grib_count_messages.f90 +++ b/examples/F90/grib_count_messages.f90 @@ -10,101 +10,100 @@ ! ! program get - use eccodes - implicit none + use eccodes + implicit none - integer :: ifile - integer :: iret - integer :: n - integer :: i - integer,dimension(:),allocatable :: igrib - real :: latitudeOfFirstPointInDegrees - real :: longitudeOfFirstPointInDegrees - real :: latitudeOfLastPointInDegrees - real :: longitudeOfLastPointInDegrees - integer :: numberOfPointsAlongAParallel - integer :: numberOfPointsAlongAMeridian - real, dimension(:), allocatable :: values - integer :: numberOfValues - real :: average,min_val, max_val + integer :: ifile + integer :: iret + integer :: n + integer :: i + integer, dimension(:), allocatable :: igrib + real :: latitudeOfFirstPointInDegrees + real :: longitudeOfFirstPointInDegrees + real :: latitudeOfLastPointInDegrees + real :: longitudeOfLastPointInDegrees + integer :: numberOfPointsAlongAParallel + integer :: numberOfPointsAlongAMeridian + real, dimension(:), allocatable :: values + integer :: numberOfValues + real :: average, min_val, max_val - call codes_open_file(ifile, & - '../../data/tigge_pf_ecmwf.grib2','r') + call codes_open_file(ifile, & + '../../data/tigge_pf_ecmwf.grib2', 'r') - ! count the messages in the file - call codes_count_in_file(ifile,n) - allocate(igrib(n)) - igrib=-1 + ! count the messages in the file + call codes_count_in_file(ifile, n) + allocate (igrib(n)) + igrib = -1 - ! Load the messages from the file. - DO i=1,n - call codes_grib_new_from_file(ifile,igrib(i), iret) - END DO + ! Load the messages from the file. + DO i = 1, n + call codes_grib_new_from_file(ifile, igrib(i), iret) + END DO - ! we can close the file - call codes_close_file(ifile) + ! we can close the file + call codes_close_file(ifile) - ! Loop on all the messages in memory - DO i=1,n - write(*,*) 'processing message number ',i - ! get as a integer - call codes_get(igrib(i),'Ni',numberOfPointsAlongAParallel) - write(*,*) 'numberOfPointsAlongAParallel=', & - numberOfPointsAlongAParallel + ! Loop on all the messages in memory + DO i = 1, n + write (*, *) 'processing message number ', i + ! get as a integer + call codes_get(igrib(i), 'Ni', numberOfPointsAlongAParallel) + write (*, *) 'numberOfPointsAlongAParallel=', & + numberOfPointsAlongAParallel - ! get as a integer - call codes_get(igrib(i),'Nj',numberOfPointsAlongAMeridian) - write(*,*) 'numberOfPointsAlongAMeridian=', & - numberOfPointsAlongAMeridian + ! get as a integer + call codes_get(igrib(i), 'Nj', numberOfPointsAlongAMeridian) + write (*, *) 'numberOfPointsAlongAMeridian=', & + numberOfPointsAlongAMeridian - ! get as a real - call codes_get(igrib(i), 'latitudeOfFirstGridPointInDegrees', & - latitudeOfFirstPointInDegrees) - write(*,*) 'latitudeOfFirstGridPointInDegrees=', & - latitudeOfFirstPointInDegrees + ! get as a real + call codes_get(igrib(i), 'latitudeOfFirstGridPointInDegrees', & + latitudeOfFirstPointInDegrees) + write (*, *) 'latitudeOfFirstGridPointInDegrees=', & + latitudeOfFirstPointInDegrees - ! get as a real - call codes_get(igrib(i), 'longitudeOfFirstGridPointInDegrees', & - longitudeOfFirstPointInDegrees) - write(*,*) 'longitudeOfFirstGridPointInDegrees=', & + ! get as a real + call codes_get(igrib(i), 'longitudeOfFirstGridPointInDegrees', & + longitudeOfFirstPointInDegrees) + write (*, *) 'longitudeOfFirstGridPointInDegrees=', & longitudeOfFirstPointInDegrees - ! get as a real - call codes_get(igrib(i), 'latitudeOfLastGridPointInDegrees', & - latitudeOfLastPointInDegrees) - write(*,*) 'latitudeOfLastGridPointInDegrees=', & + ! get as a real + call codes_get(igrib(i), 'latitudeOfLastGridPointInDegrees', & + latitudeOfLastPointInDegrees) + write (*, *) 'latitudeOfLastGridPointInDegrees=', & latitudeOfLastPointInDegrees - ! get as a real - call codes_get(igrib(i), 'longitudeOfLastGridPointInDegrees', & - longitudeOfLastPointInDegrees) - write(*,*) 'longitudeOfLastGridPointInDegrees=', & + ! get as a real + call codes_get(igrib(i), 'longitudeOfLastGridPointInDegrees', & + longitudeOfLastPointInDegrees) + write (*, *) 'longitudeOfLastGridPointInDegrees=', & longitudeOfLastPointInDegrees + ! get the size of the values array + call codes_get_size(igrib(i), 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - ! get the size of the values array - call codes_get_size(igrib(i),'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + allocate (values(numberOfValues), stat=iret) + ! get data values + call codes_get(igrib(i), 'values', values) + call codes_get(igrib(i), 'min', min_val) ! can also be obtained through minval(values) + call codes_get(igrib(i), 'max', max_val) ! can also be obtained through maxval(values) + call codes_get(igrib(i), 'average', average) ! can also be obtained through maxval(values) - allocate(values(numberOfValues), stat=iret) - ! get data values - call codes_get(igrib(i),'values',values) - call codes_get(igrib(i),'min',min_val) ! can also be obtained through minval(values) - call codes_get(igrib(i),'max',max_val) ! can also be obtained through maxval(values) - call codes_get(igrib(i),'average',average) ! can also be obtained through maxval(values) + write (*, *) 'There are ', numberOfValues, & + ' average is ', average, & + ' min is ', min_val, & + ' max is ', max_val + write (*, *) '---------------------' + deallocate (values) + END DO - write(*,*)'There are ',numberOfValues, & - ' average is ',average, & - ' min is ', min_val, & - ' max is ', max_val - write(*,*) '---------------------' - deallocate(values) - END DO + DO i = 1, n + call codes_release(igrib(i)) + END DO - DO i=1,n - call codes_release(igrib(i)) - END DO - - deallocate(igrib) + deallocate (igrib) end program get diff --git a/examples/F90/grib_count_messages_multi.f90 b/examples/F90/grib_count_messages_multi.f90 index 75b6668fb..7f1244780 100644 --- a/examples/F90/grib_count_messages_multi.f90 +++ b/examples/F90/grib_count_messages_multi.f90 @@ -10,25 +10,25 @@ ! ! program grib_count_messages_multi - use eccodes - implicit none + use eccodes + implicit none - integer :: ifile - character(len=100) :: grib_file - integer :: n,stat - character(len=1) :: multi_flag + integer :: ifile + character(len=100) :: grib_file + integer :: n, stat + character(len=1) :: multi_flag - call getarg(1,multi_flag) - call getarg(2,grib_file) + call getarg(1, multi_flag) + call getarg(2, grib_file) - if (multi_flag/="0") call codes_grib_multi_support_on() + if (multi_flag /= "0") call codes_grib_multi_support_on() - call codes_open_file(ifile,grib_file,'r') + call codes_open_file(ifile, grib_file, 'r') - ! count the messages in the file - call codes_count_in_file(ifile,n,stat) + ! count the messages in the file + call codes_count_in_file(ifile, n, stat) - print *,n + print *, n - call codes_close_file(ifile) + call codes_close_file(ifile) end program grib_count_messages_multi diff --git a/examples/F90/grib_ecc-671.f90 b/examples/F90/grib_ecc-671.f90 index 31d5aad80..4dc714a27 100644 --- a/examples/F90/grib_ecc-671.f90 +++ b/examples/F90/grib_ecc-671.f90 @@ -11,23 +11,23 @@ ! USE eccodes - INTEGER :: IGRIBH - CHARACTER (LEN=17) :: CLNOMA1, CLNOMA2 +INTEGER :: IGRIBH +CHARACTER(LEN=17) :: CLNOMA1, CLNOMA2 - CALL codes_grib_new_from_samples(IGRIBH, "regular_ll_sfc_grib2") +CALL codes_grib_new_from_samples(IGRIBH, "regular_ll_sfc_grib2") - ! set centre to MeteoFrance and use their local definition - CALL codes_set (IGRIBH, 'centre', 85) - CALL codes_set (IGRIBH, 'grib2LocalSectionPresent', 1) - CALL codes_set (IGRIBH, 'grib2LocalSectionNumber', 1) +! set centre to MeteoFrance and use their local definition +CALL codes_set(IGRIBH, 'centre', 85) +CALL codes_set(IGRIBH, 'grib2LocalSectionPresent', 1) +CALL codes_set(IGRIBH, 'grib2LocalSectionNumber', 1) - CLNOMA1 = 'SUNSHI. DURATION' - CALL codes_set_string(IGRIBH, 'CLNOMA', CLNOMA1) - CALL codes_get_string(IGRIBH, 'CLNOMA', CLNOMA2) +CLNOMA1 = 'SUNSHI. DURATION' +CALL codes_set_string(IGRIBH, 'CLNOMA', CLNOMA1) +CALL codes_get_string(IGRIBH, 'CLNOMA', CLNOMA2) - PRINT *, " CLNOMA1 = ", CLNOMA1 - PRINT *, " CLNOMA2 = ", CLNOMA2 +PRINT *, " CLNOMA1 = ", CLNOMA1 +PRINT *, " CLNOMA2 = ", CLNOMA2 - IF (CLNOMA1 /= CLNOMA2) STOP 1 +IF (CLNOMA1 /= CLNOMA2) STOP 1 END diff --git a/examples/F90/grib_get_data.f90 b/examples/F90/grib_get_data.f90 index 315c0fd05..44047bd67 100644 --- a/examples/F90/grib_get_data.f90 +++ b/examples/F90/grib_get_data.f90 @@ -11,71 +11,71 @@ ! ! program get_data -use eccodes -implicit none - integer :: ifile - integer :: iret,i - real(kind=8),dimension(:),allocatable :: lats,lons,values - integer,dimension(:),allocatable :: bitmap - integer(4) :: numberOfPoints - logical :: is_missing_value - integer :: count1=0, count2=0, bitmapPresent=0, bmp_len=0 + use eccodes + implicit none + integer :: ifile + integer :: iret, i + real(kind=8), dimension(:), allocatable :: lats, lons, values + integer, dimension(:), allocatable :: bitmap + integer(4) :: numberOfPoints + logical :: is_missing_value + integer :: count1 = 0, count2 = 0, bitmapPresent = 0, bmp_len = 0 - ! Message identifier. - integer :: igrib + ! Message identifier. + integer :: igrib - ifile=5 + ifile = 5 - call codes_open_file(ifile, & - '../../data/reduced_latlon_surface.grib1','R') + call codes_open_file(ifile, & + '../../data/reduced_latlon_surface.grib1', 'R') - ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib,iret) + ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) - do while (iret/=CODES_END_OF_FILE) - count1=count1+1 - print *, "===== Message #",count1 - call codes_get(igrib,'numberOfPoints',numberOfPoints) - call codes_get(igrib,'bitmapPresent',bitmapPresent) + do while (iret /= CODES_END_OF_FILE) + count1 = count1 + 1 + print *, "===== Message #", count1 + call codes_get(igrib, 'numberOfPoints', numberOfPoints) + call codes_get(igrib, 'bitmapPresent', bitmapPresent) - allocate(lats(numberOfPoints)) - allocate(lons(numberOfPoints)) - allocate(values(numberOfPoints)) - if (bitmapPresent == 1) then - ! get the bitmap - call codes_get_size(igrib, 'bitmap', bmp_len) - allocate(bitmap(bmp_len)) - call codes_get(igrib,'bitmap', bitmap) - end if - - call codes_grib_get_data(igrib,lats,lons,values) - - do i=1,numberOfPoints - ! Consult bitmap to see if the i'th value is missing - is_missing_value=.false. - if (bitmapPresent == 1 .and. bitmap(i) == 0) then - is_missing_value=.true. + allocate (lats(numberOfPoints)) + allocate (lons(numberOfPoints)) + allocate (values(numberOfPoints)) + if (bitmapPresent == 1) then + ! get the bitmap + call codes_get_size(igrib, 'bitmap', bmp_len) + allocate (bitmap(bmp_len)) + call codes_get(igrib, 'bitmap', bitmap) end if - ! Only print non-missing values - if (.not. is_missing_value) then - print *, lats(i),lons(i),values(i) - count2=count2+1 + + call codes_grib_get_data(igrib, lats, lons, values) + + do i = 1, numberOfPoints + ! Consult bitmap to see if the i'th value is missing + is_missing_value = .false. + if (bitmapPresent == 1 .and. bitmap(i) == 0) then + is_missing_value = .true. + end if + ! Only print non-missing values + if (.not. is_missing_value) then + print *, lats(i), lons(i), values(i) + count2 = count2 + 1 + end if + end do + print *, 'count of non-missing values=', count2 + if (count2 /= 214661) then + call codes_check(-2, 'incorrect number of missing', '') end if - enddo - print *, 'count of non-missing values=',count2 - if (count2 /= 214661) then - call codes_check(-2, 'incorrect number of missing', '') - end if - deallocate(lats) - deallocate(lons) - deallocate(values) + deallocate (lats) + deallocate (lons) + deallocate (values) - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) - end do + end do - call codes_close_file(ifile) + call codes_close_file(ifile) end program diff --git a/examples/F90/grib_get_keys.f90 b/examples/F90/grib_get_keys.f90 index ca1bdb53f..36f87c6af 100644 --- a/examples/F90/grib_get_keys.f90 +++ b/examples/F90/grib_get_keys.f90 @@ -11,100 +11,100 @@ ! ! program grib_get_keys - use eccodes - implicit none + use eccodes + implicit none - integer :: ifile - integer :: iret - integer :: igrib - real :: latitudeOfFirstPointInDegrees - real :: longitudeOfFirstPointInDegrees - real :: latitudeOfLastPointInDegrees - real :: longitudeOfLastPointInDegrees - integer :: numberOfPointsAlongAParallel - integer :: numberOfPointsAlongAMeridian - real, dimension(:), allocatable :: values - integer :: numberOfValues - real :: average,min_val, max_val - integer :: is_missing - character(len=10) :: open_mode='r' + integer :: ifile + integer :: iret + integer :: igrib + real :: latitudeOfFirstPointInDegrees + real :: longitudeOfFirstPointInDegrees + real :: latitudeOfLastPointInDegrees + real :: longitudeOfLastPointInDegrees + integer :: numberOfPointsAlongAParallel + integer :: numberOfPointsAlongAMeridian + real, dimension(:), allocatable :: values + integer :: numberOfValues + real :: average, min_val, max_val + integer :: is_missing + character(len=10) :: open_mode = 'r' - call codes_open_file(ifile, & - '../../data/reduced_latlon_surface.grib1', open_mode) + call codes_open_file(ifile, & + '../../data/reduced_latlon_surface.grib1', open_mode) - ! Loop on all the messages in a file. + ! Loop on all the messages in a file. - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib, iret) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib, iret) - LOOP: DO WHILE (iret /= CODES_END_OF_FILE) + LOOP: DO WHILE (iret /= CODES_END_OF_FILE) - ! Check if the value of the key is MISSING - is_missing=0; - call codes_is_missing(igrib,'Ni',is_missing); - if ( is_missing /= 1 ) then - ! Key value is not missing so get as an integer - call codes_get(igrib,'Ni',numberOfPointsAlongAParallel) - write(*,*) 'numberOfPointsAlongAParallel=', & - numberOfPointsAlongAParallel - else - write(*,*) 'numberOfPointsAlongAParallel is missing' - endif + ! Check if the value of the key is MISSING + is_missing = 0; + call codes_is_missing(igrib, 'Ni', is_missing); + if (is_missing /= 1) then + ! Key value is not missing so get as an integer + call codes_get(igrib, 'Ni', numberOfPointsAlongAParallel) + write (*, *) 'numberOfPointsAlongAParallel=', & + numberOfPointsAlongAParallel + else + write (*, *) 'numberOfPointsAlongAParallel is missing' + end if - ! Get as an integer - call codes_get(igrib,'Nj',numberOfPointsAlongAMeridian) - write(*,*) 'numberOfPointsAlongAMeridian=', & + ! Get as an integer + call codes_get(igrib, 'Nj', numberOfPointsAlongAMeridian) + write (*, *) 'numberOfPointsAlongAMeridian=', & numberOfPointsAlongAMeridian - ! Get as a real - call codes_get(igrib, 'latitudeOfFirstGridPointInDegrees', & - latitudeOfFirstPointInDegrees) - write(*,*) 'latitudeOfFirstGridPointInDegrees=', & - latitudeOfFirstPointInDegrees + ! Get as a real + call codes_get(igrib, 'latitudeOfFirstGridPointInDegrees', & + latitudeOfFirstPointInDegrees) + write (*, *) 'latitudeOfFirstGridPointInDegrees=', & + latitudeOfFirstPointInDegrees - ! Get as a real - call codes_get(igrib, 'longitudeOfFirstGridPointInDegrees', & - longitudeOfFirstPointInDegrees) - write(*,*) 'longitudeOfFirstGridPointInDegrees=', & - longitudeOfFirstPointInDegrees + ! Get as a real + call codes_get(igrib, 'longitudeOfFirstGridPointInDegrees', & + longitudeOfFirstPointInDegrees) + write (*, *) 'longitudeOfFirstGridPointInDegrees=', & + longitudeOfFirstPointInDegrees - ! Get as a real - call codes_get(igrib, 'latitudeOfLastGridPointInDegrees', & - latitudeOfLastPointInDegrees) - write(*,*) 'latitudeOfLastGridPointInDegrees=', & - latitudeOfLastPointInDegrees + ! Get as a real + call codes_get(igrib, 'latitudeOfLastGridPointInDegrees', & + latitudeOfLastPointInDegrees) + write (*, *) 'latitudeOfLastGridPointInDegrees=', & + latitudeOfLastPointInDegrees - ! Get as a real - call codes_get(igrib, 'longitudeOfLastGridPointInDegrees', & - longitudeOfLastPointInDegrees) - write(*,*) 'longitudeOfLastGridPointInDegrees=', & - longitudeOfLastPointInDegrees + ! Get as a real + call codes_get(igrib, 'longitudeOfLastGridPointInDegrees', & + longitudeOfLastPointInDegrees) + write (*, *) 'longitudeOfLastGridPointInDegrees=', & + longitudeOfLastPointInDegrees - ! Get the size of the values array - call codes_get_size(igrib,'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + ! Get the size of the values array + call codes_get_size(igrib, 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - allocate(values(numberOfValues), stat=iret) - ! Get data values - call codes_get(igrib,'values',values) - call codes_get(igrib,'min',min_val) ! can also be obtained through minval(values) - call codes_get(igrib,'max',max_val) ! can also be obtained through maxval(values) - call codes_get(igrib,'average',average) ! can also be obtained through maxval(values) + allocate (values(numberOfValues), stat=iret) + ! Get data values + call codes_get(igrib, 'values', values) + call codes_get(igrib, 'min', min_val) ! can also be obtained through minval(values) + call codes_get(igrib, 'max', max_val) ! can also be obtained through maxval(values) + call codes_get(igrib, 'average', average) ! can also be obtained through maxval(values) - deallocate(values) + deallocate (values) - write(*,*)'There are ',numberOfValues, & - ' average is ',average, & - ' min is ', min_val, & - ' max is ', max_val + write (*, *) 'There are ', numberOfValues, & + ' average is ', average, & + ' min is ', min_val, & + ' max is ', max_val - call codes_release(igrib) + call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_grib_new_from_file(ifile, igrib, iret) - end do LOOP + end do LOOP - call codes_close_file(ifile) + call codes_close_file(ifile) end program grib_get_keys diff --git a/examples/F90/grib_get_pl.f90 b/examples/F90/grib_get_pl.f90 index a13e1752a..f52c2ea9d 100644 --- a/examples/F90/grib_get_pl.f90 +++ b/examples/F90/grib_get_pl.f90 @@ -11,35 +11,35 @@ ! ! program grib_get_pl - use eccodes - implicit none - integer :: infile - integer :: igrib - integer :: PLPresent, nb_pl - real, dimension(:), allocatable :: pl + use eccodes + implicit none + integer :: infile + integer :: igrib + integer :: PLPresent, nb_pl + real, dimension(:), allocatable :: pl - call codes_open_file(infile, & - '../../data/reduced_gaussian_surface.grib1','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_surface.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! get PLPresent to see if the 'pl' array is there - call codes_get(igrib,'PLPresent',PLPresent) - print*, "PLPresent= ", PLPresent - if (PLPresent == 1) then - call codes_get_size(igrib,'pl',nb_pl) - print*, "there are ", nb_pl, " PL values" - allocate(pl(nb_pl)) - call codes_get(igrib,'pl',pl) - print*, "pl = ", pl - deallocate(pl) - else - print*, "There is no PL values in your GRIB message!" - end if - call codes_release(igrib) + ! get PLPresent to see if the 'pl' array is there + call codes_get(igrib, 'PLPresent', PLPresent) + print *, "PLPresent= ", PLPresent + if (PLPresent == 1) then + call codes_get_size(igrib, 'pl', nb_pl) + print *, "there are ", nb_pl, " PL values" + allocate (pl(nb_pl)) + call codes_get(igrib, 'pl', pl) + print *, "pl = ", pl + deallocate (pl) + else + print *, "There is no PL values in your GRIB message!" + end if + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) end program grib_get_pl diff --git a/examples/F90/grib_get_pv.f90 b/examples/F90/grib_get_pv.f90 index 2fcf8a26e..49e5aaa06 100644 --- a/examples/F90/grib_get_pv.f90 +++ b/examples/F90/grib_get_pv.f90 @@ -11,35 +11,35 @@ ! ! program grib_get_pv - use eccodes - implicit none - integer :: infile - integer :: igrib - integer :: PVPresent, nb_pv - real, dimension(:), allocatable :: pv + use eccodes + implicit none + integer :: infile + integer :: igrib + integer :: PVPresent, nb_pv + real, dimension(:), allocatable :: pv - call codes_open_file(infile, & - '../../data/reduced_gaussian_model_level.grib1','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_model_level.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! Get PVPresent to see if the 'pv' array is there - call codes_get(igrib,'PVPresent',PVPresent) - print*, "PVPresent = ", PVPresent - if (PVPresent == 1) then - call codes_get_size(igrib,'pv',nb_pv) - print*, "There are ", nb_pv, " PV values" - allocate(pv(nb_pv)) - call codes_get(igrib,'pv',pv) - print*, "pv = ", pv - deallocate(pv) - else - print*, "There is no PV values in your GRIB message!" - end if - call codes_release(igrib) + ! Get PVPresent to see if the 'pv' array is there + call codes_get(igrib, 'PVPresent', PVPresent) + print *, "PVPresent = ", PVPresent + if (PVPresent == 1) then + call codes_get_size(igrib, 'pv', nb_pv) + print *, "There are ", nb_pv, " PV values" + allocate (pv(nb_pv)) + call codes_get(igrib, 'pv', pv) + print *, "pv = ", pv + deallocate (pv) + else + print *, "There is no PV values in your GRIB message!" + end if + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) end program grib_get_pv diff --git a/examples/F90/grib_get_set_uuid.f90 b/examples/F90/grib_get_set_uuid.f90 index 17a812a3b..d51bcd9cd 100644 --- a/examples/F90/grib_get_set_uuid.f90 +++ b/examples/F90/grib_get_set_uuid.f90 @@ -12,89 +12,89 @@ ! 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 + 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(infile, '../../data/test_uuid.grib2', 'r') - call codes_open_file (outfile, 'out_uuid.grib2','w') + 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) + ! 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 + 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, '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 + ! 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 + ! 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_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_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) + 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 + ! 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 diff --git a/examples/F90/grib_index.f90 b/examples/F90/grib_index.f90 index 6195e2c05..d0d248978 100644 --- a/examples/F90/grib_index.f90 +++ b/examples/F90/grib_index.f90 @@ -13,105 +13,105 @@ ! ! program index - use eccodes - implicit none + use eccodes + implicit none - integer :: iret - integer,dimension(:),allocatable :: step,level,number - character(len=20),dimension(:),allocatable :: shortName - integer :: ostep,olevel,onumber - character(len=20) :: oshortName - integer :: shortNameSize,numberSize,levelSize,stepSize - integer :: i,j,k,l - integer :: idx,igrib,count1 - character(len=10) :: index_file='index.idx' + integer :: iret + integer, dimension(:), allocatable :: step, level, number + character(len=20), dimension(:), allocatable :: shortName + integer :: ostep, olevel, onumber + character(len=20) :: oshortName + integer :: shortNameSize, numberSize, levelSize, stepSize + integer :: i, j, k, l + integer :: idx, igrib, count1 + character(len=10) :: index_file = 'index.idx' - ! uncomment following line to load index from file - !call codes_index_read(idx,index_file) + ! uncomment following line to load index from file + !call codes_index_read(idx,index_file) - ! create an index from a grib file using some keys - call codes_index_create(idx,'../../data/index.grib','shortName,number,level,step') + ! create an index from a grib file using some keys + call codes_index_create(idx, '../../data/index.grib', 'shortName,number,level,step') - ! get the number of distinct values of shortName in the index - call codes_index_get_size(idx,'shortName',shortNameSize) - ! allocate the array to contain the list of distinct shortName - allocate(shortName(shortNameSize)) - ! get the list of distinct shortName from the index - call codes_index_get(idx,'shortName',shortName) - write(*,'(a,i3)') 'shortNameSize=',shortNameSize + ! get the number of distinct values of shortName in the index + call codes_index_get_size(idx, 'shortName', shortNameSize) + ! allocate the array to contain the list of distinct shortName + allocate (shortName(shortNameSize)) + ! get the list of distinct shortName from the index + call codes_index_get(idx, 'shortName', shortName) + write (*, '(a,i3)') 'shortNameSize=', shortNameSize - ! get the number of distinct values of number in the index - call codes_index_get_size(idx,'number',numberSize) - ! allocate the array to contain the list of distinct numbers - allocate(number(numberSize)) - ! get the list of distinct numbers from the index - call codes_index_get(idx,'number',number) - write(*,'(a,i3)') 'numberSize=',numberSize + ! get the number of distinct values of number in the index + call codes_index_get_size(idx, 'number', numberSize) + ! allocate the array to contain the list of distinct numbers + allocate (number(numberSize)) + ! get the list of distinct numbers from the index + call codes_index_get(idx, 'number', number) + write (*, '(a,i3)') 'numberSize=', numberSize - ! get the number of distinct values of level in the index - call codes_index_get_size(idx,'level',levelSize) - ! allocate the array to contain the list of distinct levels - allocate(level(levelSize)) - ! get the list of distinct levels from the index - call codes_index_get(idx,'level',level) - write(*,'(a,i3)') 'levelSize=',levelSize + ! get the number of distinct values of level in the index + call codes_index_get_size(idx, 'level', levelSize) + ! allocate the array to contain the list of distinct levels + allocate (level(levelSize)) + ! get the list of distinct levels from the index + call codes_index_get(idx, 'level', level) + write (*, '(a,i3)') 'levelSize=', levelSize - ! get the number of distinct values of step in the index - call codes_index_get_size(idx,'step',stepSize) - ! allocate the array to contain the list of distinct steps - allocate(step(stepSize)) - ! get the list of distinct steps from the index - call codes_index_get(idx,'step',step) - write(*,'(a,i3)') 'stepSize=',stepSize + ! get the number of distinct values of step in the index + call codes_index_get_size(idx, 'step', stepSize) + ! allocate the array to contain the list of distinct steps + allocate (step(stepSize)) + ! get the list of distinct steps from the index + call codes_index_get(idx, 'step', step) + write (*, '(a,i3)') 'stepSize=', stepSize - count1=0 - do l=1,stepSize ! loop on step - ! select step=step(l) - call codes_index_select(idx,'step',step(l)) + count1 = 0 + do l = 1, stepSize ! loop on step + ! select step=step(l) + call codes_index_select(idx, 'step', step(l)) - do j=1,numberSize ! loop on number - ! select number=number(j) - call codes_index_select(idx,'number',number(j)) + do j = 1, numberSize ! loop on number + ! select number=number(j) + call codes_index_select(idx, 'number', number(j)) - do k=1,levelSize ! loop on level - ! select level=level(k) - call codes_index_select(idx,'level',level(k)) + do k = 1, levelSize ! loop on level + ! select level=level(k) + call codes_index_select(idx, 'level', level(k)) - do i=1,shortNameSize ! loop on shortName - ! select shortName=shortName(i) - call codes_index_select(idx,'shortName',shortName(i)) + do i = 1, shortNameSize ! loop on shortName + ! select shortName=shortName(i) + call codes_index_select(idx, 'shortName', shortName(i)) - call codes_new_from_index(idx,igrib, iret) - do while (iret /= CODES_END_OF_INDEX) - count1=count1+1 - call codes_get(igrib,'shortName',oshortName) - call codes_get(igrib,'number',onumber) - call codes_get(igrib,'level',olevel) - call codes_get(igrib,'step',ostep) - write(*,'(A,A,A,i3,A,i4,A,i3)') 'shortName=',trim(oshortName),& - ' number=',onumber,& - ' level=' ,olevel, & - ' step=' ,ostep + call codes_new_from_index(idx, igrib, iret) + do while (iret /= CODES_END_OF_INDEX) + count1 = count1 + 1 + call codes_get(igrib, 'shortName', oshortName) + call codes_get(igrib, 'number', onumber) + call codes_get(igrib, 'level', olevel) + call codes_get(igrib, 'step', ostep) + write (*, '(A,A,A,i3,A,i4,A,i3)') 'shortName=', trim(oshortName), & + ' number=', onumber, & + ' level=', olevel, & + ' step=', ostep - call codes_release(igrib) - call codes_new_from_index(idx,igrib, iret) - end do - call codes_release(igrib) + call codes_release(igrib) + call codes_new_from_index(idx, igrib, iret) + end do + call codes_release(igrib) - end do ! loop on step - end do ! loop on level - end do ! loop on number - end do ! loop on shortName - write(*,'(i4,a)') count1,' messages selected' + end do ! loop on step + end do ! loop on level + end do ! loop on number + end do ! loop on shortName + write (*, '(i4,a)') count1, ' messages selected' - ! save the index to a file for later reuse - call codes_index_write(idx,index_file) + ! save the index to a file for later reuse + call codes_index_write(idx, index_file) - call codes_index_release(idx) - - deallocate(level) - deallocate(shortName) - deallocate(step) - deallocate(number) + call codes_index_release(idx) + + deallocate (level) + deallocate (shortName) + deallocate (step) + deallocate (number) end program index diff --git a/examples/F90/grib_keys_iterator.f90 b/examples/F90/grib_keys_iterator.f90 index 93b0d9d6f..ca00157b4 100644 --- a/examples/F90/grib_keys_iterator.f90 +++ b/examples/F90/grib_keys_iterator.f90 @@ -14,50 +14,49 @@ ! ! program keys_iterator - use eccodes - implicit none - character(len=20) :: name_space - integer :: kiter,ifile,igrib,iret - character(len=256) :: key - character(len=256) :: value - character(len=512) :: all1 - integer :: grib_count + use eccodes + implicit none + character(len=20) :: name_space + integer :: kiter, ifile, igrib, iret + character(len=256) :: key + character(len=256) :: value + character(len=512) :: all1 + integer :: grib_count - call codes_open_file(ifile, & - '../../data/regular_latlon_surface.grib1','r') + call codes_open_file(ifile, & + '../../data/regular_latlon_surface.grib1', 'r') - ! Loop on all the messages in a file. + ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib, iret) - grib_count=0 - do while (iret /= CODES_END_OF_FILE) + call codes_grib_new_from_file(ifile, igrib, iret) + grib_count = 0 + do while (iret /= CODES_END_OF_FILE) - grib_count=grib_count+1 - write(*,*) '-- GRIB N. ',grib_count,' --' + grib_count = grib_count + 1 + write (*, *) '-- GRIB N. ', grib_count, ' --' - ! valid name_spaces are ls and mars - name_space='ls' + ! valid name_spaces are ls and mars + name_space = 'ls' - call codes_keys_iterator_new(igrib,kiter,name_space) + call codes_keys_iterator_new(igrib, kiter, name_space) - do - call codes_keys_iterator_next(kiter, iret) + do + call codes_keys_iterator_next(kiter, iret) - if (iret .ne. CODES_SUCCESS) exit !terminate the loop + if (iret .ne. CODES_SUCCESS) exit !terminate the loop - call codes_keys_iterator_get_name(kiter,key) - call codes_get(igrib,trim(key),value) - all1=trim(key)// ' = ' // trim(value) - write(*,*) trim(all1) + call codes_keys_iterator_get_name(kiter, key) + call codes_get(igrib, trim(key), value) + all1 = trim(key)//' = '//trim(value) + write (*, *) trim(all1) - end do + end do - call codes_keys_iterator_delete(kiter) - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) - end do + call codes_keys_iterator_delete(kiter) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) + end do - - call codes_close_file(ifile) + call codes_close_file(ifile) end program keys_iterator diff --git a/examples/F90/grib_multi.f90 b/examples/F90/grib_multi.f90 index 69afa90bd..d486a8eb7 100644 --- a/examples/F90/grib_multi.f90 +++ b/examples/F90/grib_multi.f90 @@ -13,33 +13,33 @@ ! For all the tools default is multi support ON. ! program multi - use eccodes - implicit none + use eccodes + implicit none - integer :: iret - integer(kind = 4) :: step - integer :: ifile,igrib + integer :: iret + integer(kind=4) :: step + integer :: ifile, igrib - call codes_open_file(ifile, '../../data/multi_created.grib2','r') + call codes_open_file(ifile, '../../data/multi_created.grib2', 'r') - ! turn on support for multi-field messages */ - call codes_grib_multi_support_on() + ! turn on support for multi-field messages */ + call codes_grib_multi_support_on() - ! turn off support for multi-field messages */ - !call codes_grib_multi_support_off() + ! turn off support for multi-field messages */ + !call codes_grib_multi_support_off() - call codes_grib_new_from_file(ifile,igrib, iret) - ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) + ! Loop on all the messages in a file. - write(*,*) 'step' - do while (iret /= CODES_END_OF_FILE) + write (*, *) 'step' + do while (iret /= CODES_END_OF_FILE) - call codes_get(igrib,'step', step) - write(*,'(i3)') step + call codes_get(igrib, 'step', step) + write (*, '(i3)') step - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_grib_new_from_file(ifile, igrib, iret) - end do - call codes_close_file(ifile) + end do + call codes_close_file(ifile) end program multi diff --git a/examples/F90/grib_multi_write.f90 b/examples/F90/grib_multi_write.f90 index 652971b94..7bec67a3e 100644 --- a/examples/F90/grib_multi_write.f90 +++ b/examples/F90/grib_multi_write.f90 @@ -15,37 +15,37 @@ ! ! program grib2_multi_write - use eccodes - implicit none - integer :: infile,outfile - integer :: in_gribid - integer :: multi_gribid - integer :: step,startsection + use eccodes + implicit none + integer :: infile, outfile + integer :: in_gribid + integer :: multi_gribid + integer :: step, startsection - ! multi field messages can be created only in edition 2 - call codes_open_file(infile,'../../data/sample.grib2','r') + ! multi field messages can be created only in edition 2 + call codes_open_file(infile, '../../data/sample.grib2', 'r') - call codes_open_file(outfile,'multi_created.grib2','w') + call codes_open_file(outfile, 'multi_created.grib2', 'w') - ! a grib message is loaded from file - ! in_gribid is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,in_gribid) + ! a grib message is loaded from file + ! in_gribid is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, in_gribid) - startsection=4 - do step=0,240,12 + startsection = 4 + do step = 0, 240, 12 - call codes_set(in_gribid,"step",step) - call codes_grib_multi_append(in_gribid,startsection,multi_gribid) + call codes_set(in_gribid, "step", step) + call codes_grib_multi_append(in_gribid, startsection, multi_gribid) - enddo + end do ! write messages to a file - call codes_grib_multi_write(multi_gribid,outfile) + call codes_grib_multi_write(multi_gribid, outfile) - call codes_release(in_gribid) - call codes_release(multi_gribid) + call codes_release(in_gribid) + call codes_release(multi_gribid) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) end program grib2_multi_write diff --git a/examples/F90/grib_nearest.f90 b/examples/F90/grib_nearest.f90 index 29735ebe8..2e2d5e1a3 100644 --- a/examples/F90/grib_nearest.f90 +++ b/examples/F90/grib_nearest.f90 @@ -12,67 +12,67 @@ ! ! program find - use eccodes - implicit none - integer :: npoints - integer :: infile - integer :: igrib, ios, i - real(8), dimension(:), allocatable :: lats, lons - real(8), dimension(:), allocatable :: nearest_lats, nearest_lons - real(8), dimension(:), allocatable :: distances, values, lsm_values - integer(kind=kindOfInt), dimension(:), allocatable :: indexes + use eccodes + implicit none + integer :: npoints + integer :: infile + integer :: igrib, ios, i + real(8), dimension(:), allocatable :: lats, lons + real(8), dimension(:), allocatable :: nearest_lats, nearest_lons + real(8), dimension(:), allocatable :: distances, values, lsm_values + integer(kind=kindOfInt), dimension(:), allocatable :: indexes - ! initialization - open( unit=1, file="../../data/list_points",form="formatted",action="read") - read(unit=1,fmt=*) npoints - allocate(lats(npoints)) - allocate(lons(npoints)) - allocate(nearest_lats(npoints)) - allocate(nearest_lons(npoints)) - allocate(distances(npoints)) - allocate(lsm_values(npoints)) - allocate(values(npoints)) - allocate(indexes(npoints)) - do i=1,npoints - read(unit=1,fmt=*, iostat=ios) lats(i), lons(i) - if (ios /= 0) then - npoints = i - 1 - exit - end if - end do - close(unit=1) - call codes_open_file(infile, & - '../../data/reduced_gaussian_lsm.grib1','r') + ! initialization + open (unit=1, file="../../data/list_points", form="formatted", action="read") + read (unit=1, fmt=*) npoints + allocate (lats(npoints)) + allocate (lons(npoints)) + allocate (nearest_lats(npoints)) + allocate (nearest_lons(npoints)) + allocate (distances(npoints)) + allocate (lsm_values(npoints)) + allocate (values(npoints)) + allocate (indexes(npoints)) + do i = 1, npoints + read (unit=1, fmt=*, iostat=ios) lats(i), lons(i) + if (ios /= 0) then + npoints = i - 1 + exit + end if + end do + close (unit=1) + call codes_open_file(infile, & + '../../data/reduced_gaussian_lsm.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_grib_find_nearest(igrib, .true., lats, lons, nearest_lats, nearest_lons,lsm_values, distances, indexes) - call codes_release(igrib) + call codes_grib_find_nearest(igrib, .true., lats, lons, nearest_lats, nearest_lons, lsm_values, distances, indexes) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - ! will apply it to another GRIB - call codes_open_file(infile, & - '../../data/reduced_gaussian_pressure_level.grib1','r') - call codes_grib_new_from_file(infile,igrib) + ! will apply it to another GRIB + call codes_open_file(infile, & + '../../data/reduced_gaussian_pressure_level.grib1', 'r') + call codes_grib_new_from_file(infile, igrib) - call codes_get_element(igrib,"values", indexes, values) - call codes_release(igrib) - call codes_close_file(infile) + call codes_get_element(igrib, "values", indexes, values) + call codes_release(igrib) + call codes_close_file(infile) - do i=1, npoints - print*,lats(i), lons(i), nearest_lats(i), nearest_lons(i), distances(i), lsm_values(i), values(i) - end do + do i = 1, npoints + print *, lats(i), lons(i), nearest_lats(i), nearest_lons(i), distances(i), lsm_values(i), values(i) + end do - deallocate(lats) - deallocate(lons) - deallocate(nearest_lats) - deallocate(nearest_lons) - deallocate(distances) - deallocate(lsm_values) - deallocate(values) - deallocate(indexes) + deallocate (lats) + deallocate (lons) + deallocate (nearest_lats) + deallocate (nearest_lons) + deallocate (distances) + deallocate (lsm_values) + deallocate (values) + deallocate (indexes) end program find diff --git a/examples/F90/grib_precision.f90 b/examples/F90/grib_precision.f90 index f4dcc5918..9a444580c 100644 --- a/examples/F90/grib_precision.f90 +++ b/examples/F90/grib_precision.f90 @@ -13,83 +13,83 @@ ! ! program precision - use eccodes - implicit none - integer(kind = 4) :: size1 - integer :: infile,outfile - integer :: igrib - real(kind = 8), dimension(:), allocatable :: values1 - real(kind = 8), dimension(:), allocatable :: values2 - real(kind = 8) :: maxa,a,maxv,minv,maxr,r - integer( kind = 4) :: decimalPrecision,bitsPerValue1,bitsPerValue2 - integer :: i, iret + use eccodes + implicit none + integer(kind=4) :: size1 + integer :: infile, outfile + integer :: igrib + real(kind=8), dimension(:), allocatable :: values1 + real(kind=8), dimension(:), allocatable :: values2 + real(kind=8) :: maxa, a, maxv, minv, maxr, r + integer(kind=4) :: decimalPrecision, bitsPerValue1, bitsPerValue2 + integer :: i, iret - call codes_open_file(infile, & - '../../data/regular_latlon_surface_constant.grib1','r') + call codes_open_file(infile, & + '../../data/regular_latlon_surface_constant.grib1', 'r') - call codes_open_file(outfile, & - '../../data/regular_latlon_surface_prec.grib1','w') + call codes_open_file(outfile, & + '../../data/regular_latlon_surface_prec.grib1', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! bitsPerValue before changing the packing parameters - call codes_get(igrib,'bitsPerValue',bitsPerValue1) + ! bitsPerValue before changing the packing parameters + call codes_get(igrib, 'bitsPerValue', bitsPerValue1) - ! get the size of the values array - call codes_get_size(igrib,"values",size1) + ! get the size of the values array + call codes_get_size(igrib, "values", size1) - allocate(values1(size1), stat=iret) - allocate(values2(size1), stat=iret) - ! get data values before changing the packing parameters*/ - call codes_get(igrib,"values",values1) + allocate (values1(size1), stat=iret) + allocate (values2(size1), stat=iret) + ! get data values before changing the packing parameters*/ + call codes_get(igrib, "values", values1) - ! setting decimal precision=2 means that 2 decimal digits - ! are preserved when packing. - decimalPrecision=2 - call codes_set(igrib,"changeDecimalPrecision", & - decimalPrecision) + ! setting decimal precision=2 means that 2 decimal digits + ! are preserved when packing. + decimalPrecision = 2 + call codes_set(igrib, "changeDecimalPrecision", & + decimalPrecision) - ! bitsPerValue after changing the packing parameters - call codes_get(igrib,"bitsPerValue",bitsPerValue2) + ! bitsPerValue after changing the packing parameters + call codes_get(igrib, "bitsPerValue", bitsPerValue2) - ! get data values after changing the packing parameters - call codes_get(igrib,"values",values2) + ! get data values after changing the packing parameters + call codes_get(igrib, "values", values2) - ! computing error - maxa=0 - maxr=0 - maxv=values2(1) - minv=maxv - do i=1,size1 - a=abs(values2(i)-values1(i)) - if ( values2(i) .gt. maxv ) maxv=values2(i) - if ( values2(i) .lt. maxv ) minv=values2(i) - if ( values2(i) .ne. 0 ) then - r=abs((values2(i)-values1(i))/values2(i)) - endif - if ( a .gt. maxa ) maxa=a - if ( r .gt. maxr ) maxr=r - enddo - write(*,*) "max absolute error = ",maxa - write(*,*) "max relative error = ",maxr - write(*,*) "min value = ",minv - write(*,*) "max value = ",maxv + ! computing error + maxa = 0 + maxr = 0 + maxv = values2(1) + minv = maxv + do i = 1, size1 + a = abs(values2(i) - values1(i)) + if (values2(i) .gt. maxv) maxv = values2(i) + if (values2(i) .lt. maxv) minv = values2(i) + if (values2(i) .ne. 0) then + r = abs((values2(i) - values1(i))/values2(i)) + end if + if (a .gt. maxa) maxa = a + if (r .gt. maxr) maxr = r + end do + write (*, *) "max absolute error = ", maxa + write (*, *) "max relative error = ", maxr + write (*, *) "min value = ", minv + write (*, *) "max value = ", maxv - write(*,*) "old number of bits per value=",bitsPerValue1 - write(*,*) "new number of bits per value=",bitsPerValue2 + write (*, *) "old number of bits per value=", bitsPerValue1 + write (*, *) "new number of bits per value=", bitsPerValue2 - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) - deallocate(values1) - deallocate(values2) + deallocate (values1) + deallocate (values2) end program precision diff --git a/examples/F90/grib_print_data.f90 b/examples/F90/grib_print_data.f90 index 9225908eb..a2aa3757b 100644 --- a/examples/F90/grib_print_data.f90 +++ b/examples/F90/grib_print_data.f90 @@ -12,49 +12,49 @@ ! ! program print_data -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: igrib -integer :: i -real(kind=8), dimension(:), allocatable :: values -integer(kind=4) :: numPoints -real(kind=8) :: average -real(kind=8) :: the_max -real(kind=8) :: the_min + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: igrib + integer :: i + real(kind=8), dimension(:), allocatable :: values + integer(kind=4) :: numPoints + real(kind=8) :: average + real(kind=8) :: the_max + real(kind=8) :: the_min - call codes_open_file(ifile, & - '../../data/constant_field.grib1','r') + call codes_open_file(ifile, & + '../../data/constant_field.grib1', 'r') - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib) - ! Get the size of the values array - call codes_get_size(igrib,'values',numPoints) + ! Get the size of the values array + call codes_get_size(igrib, 'values', numPoints) - ! Get data values - print*, 'number of points ', numPoints - allocate(values(numPoints), stat=iret) + ! Get data values + print *, 'number of points ', numPoints + allocate (values(numPoints), stat=iret) - call codes_get(igrib,'values',values) + call codes_get(igrib, 'values', values) - do i=1,numPoints - write(*,*)' ',i,values(i) - enddo + do i = 1, numPoints + write (*, *) ' ', i, values(i) + end do - write(*,*)numPoints,' values found ' + write (*, *) numPoints, ' values found ' - call codes_get(igrib,'max',the_max) - write(*,*) 'max=',the_max - call codes_get(igrib,'min',the_min) - write(*,*) 'min=',the_min - call codes_get(igrib,'average',average) - write(*,*) 'average=',average + call codes_get(igrib, 'max', the_max) + write (*, *) 'max=', the_max + call codes_get(igrib, 'min', the_min) + write (*, *) 'min=', the_min + call codes_get(igrib, 'average', average) + write (*, *) 'average=', average - call codes_release(igrib) - call codes_close_file(ifile) - deallocate(values) + call codes_release(igrib) + call codes_close_file(ifile) + deallocate (values) end program print_data diff --git a/examples/F90/grib_print_data_static.f90 b/examples/F90/grib_print_data_static.f90 index 28a64fff7..e83af8f48 100644 --- a/examples/F90/grib_print_data_static.f90 +++ b/examples/F90/grib_print_data_static.f90 @@ -13,46 +13,46 @@ ! ! program print_data -use grib_api -implicit none -integer :: ifile -integer :: igrib -integer :: i -real(kind=8), dimension(99200) :: values_static -integer(kind=4) :: numPoints -real(kind=8) :: average -real(kind=8) :: the_max -real(kind=8) :: the_min + use grib_api + implicit none + integer :: ifile + integer :: igrib + integer :: i + real(kind=8), dimension(99200) :: values_static + integer(kind=4) :: numPoints + real(kind=8) :: average + real(kind=8) :: the_max + real(kind=8) :: the_min - call grib_open_file(ifile, & - '../../data/constant_field.grib1','r') + call grib_open_file(ifile, & + '../../data/constant_field.grib1', 'r') - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call grib_new_from_file(ifile,igrib) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call grib_new_from_file(ifile, igrib) - ! Get the size of the values array - call grib_get_size(igrib,'values',numPoints) + ! Get the size of the values array + call grib_get_size(igrib, 'values', numPoints) - ! Get data values - print*, 'number of points ', numPoints + ! Get data values + print *, 'number of points ', numPoints - call grib_get(igrib,'values',values_static) + call grib_get(igrib, 'values', values_static) - do i=1,numPoints - write(*,*)' ',i,values_static(i) - enddo + do i = 1, numPoints + write (*, *) ' ', i, values_static(i) + end do - write(*,*)numPoints,' values found ' + write (*, *) numPoints, ' values found ' - call grib_get(igrib,'max',the_max) - write(*,*) 'max=',the_max - call grib_get(igrib,'min',the_min) - write(*,*) 'min=',the_min - call grib_get(igrib,'average',average) - write(*,*) 'average=',average + call grib_get(igrib, 'max', the_max) + write (*, *) 'max=', the_max + call grib_get(igrib, 'min', the_min) + write (*, *) 'min=', the_min + call grib_get(igrib, 'average', average) + write (*, *) 'average=', average - call grib_release(igrib) - call grib_close_file(ifile) + call grib_release(igrib) + call grib_close_file(ifile) end program print_data diff --git a/examples/F90/grib_read_message.f90 b/examples/F90/grib_read_message.f90 index ac0f80ff2..42c557df3 100644 --- a/examples/F90/grib_read_message.f90 +++ b/examples/F90/grib_read_message.f90 @@ -9,45 +9,45 @@ ! Description: how to get values using keys. ! program grib_read_message -use eccodes -implicit none - integer :: ifile,ofile - integer :: iret,igrib - integer , dimension(50000) :: buffer - integer(kind=kindOfSize_t) :: len1 - integer :: step,level + use eccodes + implicit none + integer :: ifile, ofile + integer :: iret, igrib + integer, dimension(50000) :: buffer + integer(kind=kindOfSize_t) :: len1 + integer :: step, level - call codes_open_file(ifile,'../../data/index.grib','r') - call codes_open_file(ofile,'out.readmsg.grib','w') + call codes_open_file(ifile, '../../data/index.grib', 'r') + call codes_open_file(ofile, 'out.readmsg.grib', 'w') ! a grib message is read from file into buffer - len1=size(buffer)*4 - call codes_read_from_file(ifile,buffer,len1,iret) + len1 = size(buffer)*4 + call codes_read_from_file(ifile, buffer, len1, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) ! a new grib message is created from buffer - call codes_new_from_message(igrib,buffer) + call codes_new_from_message(igrib, buffer) ! get as a integer - call codes_get(igrib,'step', step) - write(*,*) 'step=',step + call codes_get(igrib, 'step', step) + write (*, *) 'step=', step - call codes_get(igrib,'level',level) - write(*,*) 'level=',level + call codes_get(igrib, 'level', level) + write (*, *) 'level=', level - call codes_release(igrib) + call codes_release(igrib) - call codes_write_bytes(ofile,buffer,len1) + call codes_write_bytes(ofile, buffer, len1) ! a grib message is read from file into buffer - len1=size(buffer)*4 - call codes_read_from_file(ifile,buffer,len1,iret) + len1 = size(buffer)*4 + call codes_read_from_file(ifile, buffer, len1, iret) - enddo + end do - call codes_close_file(ifile) - call codes_close_file(ofile) + call codes_close_file(ifile) + call codes_close_file(ofile) end program grib_read_message diff --git a/examples/F90/grib_samples.f90 b/examples/F90/grib_samples.f90 index cd64b6a4b..4c0edf606 100644 --- a/examples/F90/grib_samples.f90 +++ b/examples/F90/grib_samples.f90 @@ -11,86 +11,86 @@ ! ! program sample - use eccodes - implicit none - integer :: err - integer :: outfile, datafile - integer :: igribsample,igribclone,igribdata, size1 - integer :: date1, startStep, endStep, table2Version, indicatorOfParameter - integer :: decimalPrecision - character(len=10) stepType - real(kind=8), dimension(:), allocatable :: v1,v2,v + use eccodes + implicit none + integer :: err + integer :: outfile, datafile + integer :: igribsample, igribclone, igribdata, size1 + integer :: date1, startStep, endStep, table2Version, indicatorOfParameter + integer :: decimalPrecision + character(len=10) stepType + real(kind=8), dimension(:), allocatable :: v1, v2, v - date1 = 20080104 - startStep = 0 - endStep = 12 - stepType = 'accum' - table2Version = 2 - indicatorOfParameter = 61 - decimalPrecision = 2 + date1 = 20080104 + startStep = 0 + endStep = 12 + stepType = 'accum' + table2Version = 2 + indicatorOfParameter = 61 + decimalPrecision = 2 - ! A new grib message is loaded from an existing sample. - ! Samples are searched in a default sample path (use codes_info - ! to see where that is). The default sample path can be changed by - ! setting the environment variable ECCODES_SAMPLES_PATH - call codes_grib_new_from_samples(igribsample, "regular_latlon_surface.grib1") + ! A new grib message is loaded from an existing sample. + ! Samples are searched in a default sample path (use codes_info + ! to see where that is). The default sample path can be changed by + ! setting the environment variable ECCODES_SAMPLES_PATH + call codes_grib_new_from_samples(igribsample, "regular_latlon_surface.grib1") - call codes_open_file(outfile, 'f_out.samples.grib1','w') - call codes_open_file(datafile,'../../data/tp_ecmwf.grib','r') + call codes_open_file(outfile, 'f_out.samples.grib1', 'w') + call codes_open_file(datafile, '../../data/tp_ecmwf.grib', 'r') - call codes_grib_new_from_file(datafile,igribdata,err) + call codes_grib_new_from_file(datafile, igribdata, err) - call codes_get_size(igribdata,'values',size1) - allocate(v(size1)) - allocate(v1(size1)) - allocate(v2(size1)) + call codes_get_size(igribdata, 'values', size1) + allocate (v(size1)) + allocate (v1(size1)) + allocate (v2(size1)) - call codes_get(igribdata,'values',v) + call codes_get(igribdata, 'values', v) - v=v*1000.0 ! different units for the output grib - v1=v + v = v*1000.0 ! different units for the output grib + v1 = v - do while (err/=CODES_END_OF_FILE) + do while (err /= CODES_END_OF_FILE) - call codes_clone(igribsample,igribclone) ! clone sample before modifying it + call codes_clone(igribsample, igribclone) ! clone sample before modifying it - call codes_set(igribclone,'dataDate',date1) - call codes_set(igribclone,'table2Version',table2Version) - call codes_set(igribclone,'indicatorOfParameter',indicatorOfParameter) + call codes_set(igribclone, 'dataDate', date1) + call codes_set(igribclone, 'table2Version', table2Version) + call codes_set(igribclone, 'indicatorOfParameter', indicatorOfParameter) - call codes_set(igribclone,'stepType',stepType) - call codes_set(igribclone,'startStep',startStep) - call codes_set(igribclone,'endStep',endStep) + call codes_set(igribclone, 'stepType', stepType) + call codes_set(igribclone, 'startStep', startStep) + call codes_set(igribclone, 'endStep', endStep) - call codes_set(igribclone,'decimalPrecision',decimalPrecision) + call codes_set(igribclone, 'decimalPrecision', decimalPrecision) - call codes_set(igribclone,'values',v) + call codes_set(igribclone, 'values', v) - call codes_write(igribclone,outfile) + call codes_write(igribclone, outfile) - call codes_grib_new_from_file(datafile,igribdata,err) + call codes_grib_new_from_file(datafile, igribdata, err) - if (err==0) then - call codes_get(igribdata,'values',v2) + if (err == 0) then + call codes_get(igribdata, 'values', v2) - v2=v2*1000.0 ! different units for the output grib + v2 = v2*1000.0 ! different units for the output grib - v=v2-v1 ! accumulation from startStep to endStep + v = v2 - v1 ! accumulation from startStep to endStep - v1=v2 ! save previous step field + v1 = v2 ! save previous step field - startStep=startStep+12 - endStep=endStep+12 + startStep = startStep + 12 + endStep = endStep + 12 - endif + end if - enddo + end do - call codes_release(igribsample) - deallocate(v) - deallocate(v1) - deallocate(v2) + call codes_release(igribsample) + deallocate (v) + deallocate (v1) + deallocate (v2) - call codes_close_file(outfile) + call codes_close_file(outfile) end program sample diff --git a/examples/F90/grib_set_bitmap.f90 b/examples/F90/grib_set_bitmap.f90 index e9b4c064c..e2c2d6de4 100644 --- a/examples/F90/grib_set_bitmap.f90 +++ b/examples/F90/grib_set_bitmap.f90 @@ -13,67 +13,67 @@ ! ! program set_bitmap - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib, iret - integer :: numberOfValues - real, dimension(:), allocatable :: values - real :: missingValue - logical :: grib1Example + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib, iret + integer :: numberOfValues + real, dimension(:), allocatable :: values + real :: missingValue + logical :: grib1Example - grib1Example=.true. + grib1Example = .true. - if (grib1Example) then - ! GRIB 1 example - call codes_open_file(infile,'../../data/regular_latlon_surface.grib1','r') - else - ! GRIB 2 example - call codes_open_file(infile,'../../data/regular_latlon_surface.grib2','r') - end if + if (grib1Example) then + ! GRIB 1 example + call codes_open_file(infile, '../../data/regular_latlon_surface.grib1', 'r') + else + ! GRIB 2 example + call codes_open_file(infile, '../../data/regular_latlon_surface.grib2', 'r') + end if - call codes_open_file(outfile,'out.set_bitmap_f.grib','w') + call codes_open_file(outfile, 'out.set_bitmap_f.grib', 'w') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! The missingValue is not coded in the message. - ! It is a value we define as a placeholder for a missing value - ! at a point in the grid. - ! It should be chosen so that it cannot be confused - ! with a valid field value - missingValue=9999 - call codes_set(igrib, 'missingValue',missingValue) - write(*,*) 'missingValue=',missingValue + ! The missingValue is not coded in the message. + ! It is a value we define as a placeholder for a missing value + ! at a point in the grid. + ! It should be chosen so that it cannot be confused + ! with a valid field value + missingValue = 9999 + call codes_set(igrib, 'missingValue', missingValue) + write (*, *) 'missingValue=', missingValue - ! get the size of the values array - call codes_get_size(igrib,'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + ! get the size of the values array + call codes_get_size(igrib, 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - allocate(values(numberOfValues), stat=iret) + allocate (values(numberOfValues), stat=iret) - ! get data values - call codes_get(igrib,'values',values) + ! get data values + call codes_get(igrib, 'values', values) - ! enable bitmap - call codes_set(igrib, 'bitmapPresent', 1) + ! enable bitmap + call codes_set(igrib, 'bitmapPresent', 1) - ! set some values to be missing - values(1:10) = missingValue + ! set some values to be missing + values(1:10) = missingValue - ! set the values (the bitmap will be automatically built) - call codes_set(igrib,'values', values) + ! set the values (the bitmap will be automatically built) + call codes_set(igrib, 'values', values) - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - ! free memory - call codes_release(igrib) + ! free memory + call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) - deallocate(values) + deallocate (values) end program set_bitmap diff --git a/examples/F90/grib_set_data.f90 b/examples/F90/grib_set_data.f90 index fcaa2711b..3ceec5535 100644 --- a/examples/F90/grib_set_data.f90 +++ b/examples/F90/grib_set_data.f90 @@ -13,51 +13,51 @@ ! If there are missing values, refer to: grib_set_bitmap ! program set_data - use eccodes - implicit none - integer :: outfile - integer :: i, igrib, iret, numberOfValues, cnt - real :: d, e - real, dimension(:), allocatable :: values - integer, parameter :: max_strsize = 200 - character(len=max_strsize) :: outfile_name + use eccodes + implicit none + integer :: outfile + integer :: i, igrib, iret, numberOfValues, cnt + real :: d, e + real, dimension(:), allocatable :: values + integer, parameter :: max_strsize = 200 + character(len=max_strsize) :: outfile_name - call getarg(1, outfile_name) - call codes_open_file(outfile,outfile_name,'w') + call getarg(1, outfile_name) + call codes_open_file(outfile, outfile_name, 'w') - ! Note: the full name of the sample file is "regular_ll_pl_grib1.tmpl" - ! Sample files are stored in the samples directory (use codes_info to - ! see where that is). The default sample path can be changed by - ! setting the environment variable ECCODES_SAMPLES_PATH - call codes_grib_new_from_samples(igrib, 'regular_ll_pl_grib1') + ! Note: the full name of the sample file is "regular_ll_pl_grib1.tmpl" + ! Sample files are stored in the samples directory (use codes_info to + ! see where that is). The default sample path can be changed by + ! setting the environment variable ECCODES_SAMPLES_PATH + call codes_grib_new_from_samples(igrib, 'regular_ll_pl_grib1') - ! Here we're changing the data values only, so the number of values - ! will be the same as the sample GRIB. - ! But if your data array has a different size, then specify the grid geometry - ! (e.g. keys Ni, Nj etc) and set the correct number of data values - call codes_get_size(igrib,'values',numberOfValues) + ! Here we're changing the data values only, so the number of values + ! will be the same as the sample GRIB. + ! But if your data array has a different size, then specify the grid geometry + ! (e.g. keys Ni, Nj etc) and set the correct number of data values + call codes_get_size(igrib, 'values', numberOfValues) - allocate(values(numberOfValues), stat=iret) - d = 10e-8 - e = d - cnt = 1 - do i=1,numberOfValues - if (cnt>100) then - e = e*10 - cnt=1 - endif - values(i) = d - !print *, values(i) - d = d + e - cnt = cnt + 1 - end do + allocate (values(numberOfValues), stat=iret) + d = 10e-8 + e = d + cnt = 1 + do i = 1, numberOfValues + if (cnt > 100) then + e = e*10 + cnt = 1 + end if + values(i) = d + !print *, values(i) + d = d + e + cnt = cnt + 1 + end do - call codes_set(igrib, 'bitsPerValue', 16) + call codes_set(igrib, 'bitsPerValue', 16) - ! set data values - call codes_set(igrib,'values', values) - call codes_write(igrib,outfile) - call codes_release(igrib) - deallocate(values) + ! set data values + call codes_set(igrib, 'values', values) + call codes_write(igrib, outfile) + call codes_release(igrib) + deallocate (values) end program set_data diff --git a/examples/F90/grib_set_gvc.f90 b/examples/F90/grib_set_gvc.f90 index 994ead1e5..763c44a53 100644 --- a/examples/F90/grib_set_gvc.f90 +++ b/examples/F90/grib_set_gvc.f90 @@ -13,55 +13,55 @@ ! ! program set - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib - call codes_open_file(infile, '../../data/sample.grib2','r') + call codes_open_file(infile, '../../data/sample.grib2', 'r') - call codes_open_file(outfile, 'out_gvc.grib2','w') + call codes_open_file(outfile, 'out_gvc.grib2', 'w') - call codes_grib_new_from_file(infile,igrib) + call codes_grib_new_from_file(infile, igrib) - ! Individual ensemble forecast - call codes_set(igrib,'productDefinitionTemplateNumber', 11) + ! Individual ensemble forecast + call codes_set(igrib, 'productDefinitionTemplateNumber', 11) - ! Select level type as Generalized Vertical Height Coordinate - call codes_set(igrib,'typeOfLevel', 'generalVertical') + ! Select level type as Generalized Vertical Height Coordinate + call codes_set(igrib, 'typeOfLevel', 'generalVertical') - ! Now set keys specific to this level type - call codes_set(igrib,'nlev', 12.21) - call codes_set(igrib,'numberOfVGridUsed', 13.55) + ! Now set keys specific to this level type + call codes_set(igrib, 'nlev', 12.21) + call codes_set(igrib, 'numberOfVGridUsed', 13.55) - ! check integrity of GRIB message - call check_settings(igrib) + ! check integrity of GRIB message + call check_settings(igrib) - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_release(igrib) + call codes_close_file(infile) + call codes_close_file(outfile) contains !====================================== -subroutine check_settings(gribid) - implicit none - integer, intent(in) :: gribid + subroutine check_settings(gribid) + implicit none + integer, intent(in) :: gribid - integer(kind = 4) :: NV,typeOfFirstFixedSurface + integer(kind=4) :: NV, typeOfFirstFixedSurface - call codes_get(gribid,'NV', NV) - if (NV /= 6) then - call codes_check(-2, 'NV_should_be_6', '') - end if + call codes_get(gribid, 'NV', NV) + if (NV /= 6) then + call codes_check(-2, 'NV_should_be_6', '') + end if - call codes_get(gribid,'typeOfFirstFixedSurface', typeOfFirstFixedSurface) - if (typeOfFirstFixedSurface /= 150) then - call codes_check(-2, 'typeOfFirstFixedSurface_should_be_150', '') - end if + call codes_get(gribid, 'typeOfFirstFixedSurface', typeOfFirstFixedSurface) + if (typeOfFirstFixedSurface /= 150) then + call codes_check(-2, 'typeOfFirstFixedSurface_should_be_150', '') + end if -end subroutine check_settings + end subroutine check_settings end program set diff --git a/examples/F90/grib_set_keys.f90 b/examples/F90/grib_set_keys.f90 index 60e76e6f0..dfbb7b9b5 100644 --- a/examples/F90/grib_set_keys.f90 +++ b/examples/F90/grib_set_keys.f90 @@ -11,69 +11,69 @@ ! ! program set - use eccodes - implicit none - integer(kind = 4) :: centre, date1 - integer :: infile,outfile - integer :: igrib - character(len=12) :: marsType = 'ses' + use eccodes + implicit none + integer(kind=4) :: centre, date1 + integer :: infile, outfile + integer :: igrib + character(len=12) :: marsType = 'ses' - centre = 80 - call current_date(date1) - call codes_open_file(infile, '../../data/regular_latlon_surface_constant.grib1','r') - call codes_open_file(outfile, 'out.set.grib1','w') + centre = 80 + call current_date(date1) + call codes_open_file(infile, '../../data/regular_latlon_surface_constant.grib1', 'r') + call codes_open_file(outfile, 'out.set.grib1', 'w') - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_set(igrib,'dataDate',date1) - call codes_set(igrib,'type', marsType) + call codes_set(igrib, 'dataDate', date1) + call codes_set(igrib, 'type', marsType) - ! set centre as a integer */ - call codes_set(igrib,'centre',centre) + ! set centre as a integer */ + call codes_set(igrib, 'centre', centre) - ! Check if it is correct in the actual GRIB message - call check_settings(igrib) + ! Check if it is correct in the actual GRIB message + call check_settings(igrib) - ! Write modified message to a file - call codes_write(igrib,outfile) + ! Write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) contains !====================================== -subroutine current_date(date1) -integer, intent(out) :: date1 + subroutine current_date(date1) + integer, intent(out) :: date1 -integer :: val_date(8) -call date_and_time ( values = val_date) + integer :: val_date(8) + call date_and_time(values=val_date) -date1 = val_date(1)* 10000 + val_date(2)*100 + val_date(3) -end subroutine current_date + date1 = val_date(1)*10000 + val_date(2)*100 + val_date(3) + end subroutine current_date !====================================== -subroutine check_settings(gribid) - implicit none - integer, intent(in) :: gribid + subroutine check_settings(gribid) + implicit none + integer, intent(in) :: gribid - integer(kind = 4) :: int_value - character(len = 10) :: string_value + integer(kind=4) :: int_value + character(len=10) :: string_value - ! get centre as a integer - call codes_get(gribid,'centre',int_value) - write(*,*) "get centre as a integer - centre = ",int_value + ! get centre as a integer + call codes_get(gribid, 'centre', int_value) + write (*, *) "get centre as a integer - centre = ", int_value - ! get centre as a string - call codes_get(gribid,'centre',string_value) - write(*,*) "get centre as a string - centre = ",string_value + ! get centre as a string + call codes_get(gribid, 'centre', string_value) + write (*, *) "get centre as a string - centre = ", string_value - ! get date as a string - call codes_get(gribid,'dataDate',string_value) - write(*,*) "get date as a string - date = ",string_value + ! get date as a string + call codes_get(gribid, 'dataDate', string_value) + write (*, *) "get date as a string - date = ", string_value -end subroutine check_settings + end subroutine check_settings end program set diff --git a/examples/F90/grib_set_missing.f90 b/examples/F90/grib_set_missing.f90 index e225b43eb..3f502268a 100644 --- a/examples/F90/grib_set_missing.f90 +++ b/examples/F90/grib_set_missing.f90 @@ -13,40 +13,40 @@ ! ! program set - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib, Ni, is_missing + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib, Ni, is_missing - infile=5 - outfile=6 + infile = 5 + outfile = 6 - call codes_open_file(infile, & - '../../data/reduced_gaussian_pressure_level.grib2','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_pressure_level.grib2', 'r') - call codes_open_file(outfile, & - 'f_out_surface_level.grib2','w') + call codes_open_file(outfile, & + 'f_out_surface_level.grib2', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_set(igrib,'typeOfFirstFixedSurface','sfc') - call codes_set_missing(igrib,'scaleFactorOfFirstFixedSurface') - call codes_set_missing(igrib,'scaledValueOfFirstFixedSurface') + call codes_set(igrib, 'typeOfFirstFixedSurface', 'sfc') + call codes_set_missing(igrib, 'scaleFactorOfFirstFixedSurface') + call codes_set_missing(igrib, 'scaledValueOfFirstFixedSurface') - ! See GRIB-490 - call codes_get(igrib, 'Ni', Ni) - call codes_is_missing(igrib,'Ni',is_missing) - if ( is_missing == 0 ) then - ! Ni should be missing in gribs with Reduced Gaussian grids - call codes_check(-2, 'Ni_should_be_missing', '') - endif - call codes_set(igrib, 'Ni', Ni) + ! See GRIB-490 + call codes_get(igrib, 'Ni', Ni) + call codes_is_missing(igrib, 'Ni', is_missing) + if (is_missing == 0) then + ! Ni should be missing in gribs with Reduced Gaussian grids + call codes_check(-2, 'Ni_should_be_missing', '') + end if + call codes_set(igrib, 'Ni', Ni) - call codes_write(igrib,outfile) - call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_write(igrib, outfile) + call codes_release(igrib) + call codes_close_file(infile) + call codes_close_file(outfile) end program set diff --git a/examples/F90/grib_set_packing.f90 b/examples/F90/grib_set_packing.f90 index be2babada..eb03bc3c9 100644 --- a/examples/F90/grib_set_packing.f90 +++ b/examples/F90/grib_set_packing.f90 @@ -10,45 +10,45 @@ ! e.g. Simple packing, CCSDS ! program set_packing - use eccodes - implicit none - integer :: outfile - integer :: i, igrib, iret, numberOfValues, cnt - real :: d, e - real, dimension(:), allocatable :: values - integer, parameter :: max_strsize = 200 - character(len=max_strsize) :: outfile_name, packing_type + use eccodes + implicit none + integer :: outfile + integer :: i, igrib, iret, numberOfValues, cnt + real :: d, e + real, dimension(:), allocatable :: values + integer, parameter :: max_strsize = 200 + character(len=max_strsize) :: outfile_name, packing_type - call getarg(1, packing_type) - call getarg(2, outfile_name) + call getarg(1, packing_type) + call getarg(2, outfile_name) - call codes_open_file(outfile,outfile_name,'w') + call codes_open_file(outfile, outfile_name, 'w') - call codes_grib_new_from_samples(igrib, 'gg_sfc_grib2') + call codes_grib_new_from_samples(igrib, 'gg_sfc_grib2') - call codes_get_size(igrib,'values', numberOfValues) - allocate(values(numberOfValues), stat=iret) - d = 10e-6 - e = d - cnt = 1 - do i=1,numberOfValues - if (cnt>100) then - e = e*1.01 - cnt=1 - endif - values(i) = d - d = d + e - cnt = cnt + 1 - end do + call codes_get_size(igrib, 'values', numberOfValues) + allocate (values(numberOfValues), stat=iret) + d = 10e-6 + e = d + cnt = 1 + do i = 1, numberOfValues + if (cnt > 100) then + e = e*1.01 + cnt = 1 + end if + values(i) = d + d = d + e + cnt = cnt + 1 + end do - call codes_set(igrib, 'numberOfBitsContainingEachPackedValue', 16) - call codes_set(igrib, 'packingType', packing_type) + call codes_set(igrib, 'numberOfBitsContainingEachPackedValue', 16) + call codes_set(igrib, 'packingType', packing_type) - ! set data values - call codes_set(igrib, 'values', values) + ! set data values + call codes_set(igrib, 'values', values) - call codes_write(igrib, outfile) - call codes_release(igrib) - deallocate(values) + call codes_write(igrib, outfile) + call codes_release(igrib) + deallocate (values) end program set_packing diff --git a/examples/F90/grib_set_pv.f90 b/examples/F90/grib_set_pv.f90 index 9b35fbd7f..212697339 100644 --- a/examples/F90/grib_set_pv.f90 +++ b/examples/F90/grib_set_pv.f90 @@ -12,62 +12,62 @@ ! ! program grib_set_pv - use eccodes - implicit none - integer :: numberOfLevels - integer :: numberOfCoefficients - integer :: outfile, igrib - integer :: i, ios - real, dimension(:),allocatable :: pv + use eccodes + implicit none + integer :: numberOfLevels + integer :: numberOfCoefficients + integer :: outfile, igrib + integer :: i, ios + real, dimension(:), allocatable :: pv - numberOfLevels=60 - numberOfCoefficients=2*(numberOfLevels+1) + numberOfLevels = 60 + numberOfCoefficients = 2*(numberOfLevels + 1) - allocate(pv(numberOfCoefficients)) + allocate (pv(numberOfCoefficients)) - ! read the model level coefficients from file - open( unit=1, file="../../data/60_model_levels", & - form="formatted",action="read") + ! read the model level coefficients from file + open (unit=1, file="../../data/60_model_levels", & + form="formatted", action="read") - do i=1,numberOfCoefficients,2 - read(unit=1,fmt=*, iostat=ios) pv(i), pv(i+1) - if (ios /= 0) then - print *, "I/O error: ",ios - exit - end if - end do + do i = 1, numberOfCoefficients, 2 + read (unit=1, fmt=*, iostat=ios) pv(i), pv(i + 1) + if (ios /= 0) then + print *, "I/O error: ", ios + exit + end if + end do - ! print coefficients - !do i=1,numberOfCoefficients,2 - ! print *," a=",pv(i)," b=",pv(i+1) - !end do + ! print coefficients + !do i=1,numberOfCoefficients,2 + ! print *," a=",pv(i)," b=",pv(i+1) + !end do - close(unit=1) + close (unit=1) - call codes_open_file(outfile, 'out.pv.grib1','w') + call codes_open_file(outfile, 'out.pv.grib1', 'w') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_samples(igrib, "reduced_gg_sfc_grib1") + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_samples(igrib, "reduced_gg_sfc_grib1") - ! set levtype to ml (model level) - call codes_set(igrib,'typeOfLevel','hybrid') + ! set levtype to ml (model level) + call codes_set(igrib, 'typeOfLevel', 'hybrid') - ! set level - call codes_set(igrib,'level',2) + ! set level + call codes_set(igrib, 'level', 2) - ! set PVPresent as an integer - call codes_set(igrib,'PVPresent',1) + ! set PVPresent as an integer + call codes_set(igrib, 'PVPresent', 1) - call codes_set(igrib,'pv',pv) + call codes_set(igrib, 'pv', pv) - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - ! Free memory - call codes_release(igrib) - deallocate(pv) + ! Free memory + call codes_release(igrib) + deallocate (pv) - call codes_close_file(outfile) + call codes_close_file(outfile) end program grib_set_pv diff --git a/examples/F90/iterator_fortran.f90 b/examples/F90/iterator_fortran.f90 index 73761833e..10aafaba6 100644 --- a/examples/F90/iterator_fortran.f90 +++ b/examples/F90/iterator_fortran.f90 @@ -11,60 +11,60 @@ ! ! program iterator -use eccodes -implicit none - integer :: ifile - integer :: iret,iter - real(kind=8) :: lat,lon,value,missingValue - integer :: n,flags + use eccodes + implicit none + integer :: ifile + integer :: iret, iter + real(kind=8) :: lat, lon, value, missingValue + integer :: n, flags - ! Message identifier. - integer :: igrib + ! Message identifier. + integer :: igrib - ifile=5 + ifile = 5 - call codes_open_file(ifile, & - '../../data/regular_latlon_surface_constant.grib1','R') + call codes_open_file(ifile, & + '../../data/regular_latlon_surface_constant.grib1', 'R') - ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib,iret) + ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) - LOOP: DO WHILE (iret/=CODES_END_OF_FILE) + LOOP: DO WHILE (iret /= CODES_END_OF_FILE) ! get as a real8 call codes_get(igrib, & - 'missingValue',missingValue) - write(*,*) 'missingValue=',missingValue + 'missingValue', missingValue) + write (*, *) 'missingValue=', missingValue ! A new iterator on lat/lon/values is created from the message igrib flags = 0 - call grib_iterator_new(igrib,iter,flags) + call grib_iterator_new(igrib, iter, flags) n = 0 ! Loop on all the lat/lon/values. - call grib_iterator_next(iter,lat,lon,value, iret) + call grib_iterator_next(iter, lat, lon, value, iret) do while (iret .ne. 0) ! You can now print lat and lon, - if ( value .eq. missingValue ) then - ! decide what to print if a missing value is found. - write(*,*) "- ",n," - lat=",lat," lon=",lon," value=missing" + if (value .eq. missingValue) then + ! decide what to print if a missing value is found. + write (*, *) "- ", n, " - lat=", lat, " lon=", lon, " value=missing" else - ! or print the value if is not missing. - write(*,*) " ",n," lat=",lat," lon=",lon," value=",value - endif + ! or print the value if is not missing. + write (*, *) " ", n, " lat=", lat, " lon=", lon, " value=", value + end if - n=n+1 + n = n + 1 - call grib_iterator_next(iter,lat,lon,value, iret) + call grib_iterator_next(iter, lat, lon, value, iret) end do - ! At the end the iterator is deleted to free memory. - call grib_iterator_delete(iter) - call codes_release(igrib) + ! At the end the iterator is deleted to free memory. + call grib_iterator_delete(iter) + call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_grib_new_from_file(ifile, igrib, iret) - end do LOOP + end do LOOP - call codes_close_file(ifile) + call codes_close_file(ifile) - end program iterator +end program iterator diff --git a/examples/F90/keys_iterator_fortran.f90 b/examples/F90/keys_iterator_fortran.f90 index 6181948ea..4f4addff5 100644 --- a/examples/F90/keys_iterator_fortran.f90 +++ b/examples/F90/keys_iterator_fortran.f90 @@ -14,55 +14,55 @@ ! ! program keys_iterator - use eccodes - implicit none - integer :: kiter,ifile,igrib,iret - character(len=256) :: key - character(len=256) :: value - character(len=2048) :: all - integer :: len - integer :: grib_count - len=256 + use eccodes + implicit none + integer :: kiter, ifile, igrib, iret + character(len=256) :: key + character(len=256) :: value + character(len=2048) :: all + integer :: len + integer :: grib_count + len = 256 - ifile=5 + ifile = 5 - call codes_open_file(ifile, & - '../../data/regular_latlon_surface.grib1','r') + call codes_open_file(ifile, & + '../../data/regular_latlon_surface.grib1', 'r') - grib_count=0 - ! Loop on all the messages in a file. + grib_count = 0 + ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib) + call codes_grib_new_from_file(ifile, igrib) - do while (igrib .ne. -1) + do while (igrib .ne. -1) - grib_count=grib_count+1 - write(*,'("-- GRIB N.",I4," --")') grib_count + grib_count = grib_count + 1 + write (*, '("-- GRIB N.",I4," --")') grib_count - ! valid name_spaces are ls and mars - call codes_keys_iterator_new(igrib,kiter,'ls') + ! valid name_spaces are ls and mars + call codes_keys_iterator_new(igrib, kiter, 'ls') - if (kiter .eq. -1) then - print *, 'invalid key iterator' - endif + if (kiter .eq. -1) then + print *, 'invalid key iterator' + end if - do - call codes_keys_iterator_next(kiter, iret) + do + call codes_keys_iterator_next(kiter, iret) - if (iret .ne. CODES_SUCCESS) exit + if (iret .ne. CODES_SUCCESS) exit - call codes_keys_iterator_get_name(kiter,key) + call codes_keys_iterator_get_name(kiter, key) - call codes_get(igrib,key,value) - all='|'//trim(key)//'|'//' = '//'|'//trim(value)//'|' - write(*,*) trim(all) + call codes_get(igrib, key, value) + all = '|'//trim(key)//'|'//' = '//'|'//trim(value)//'|' + write (*, *) trim(all) + end do + + call codes_keys_iterator_delete(kiter) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) end do - call codes_keys_iterator_delete(kiter) - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) - end do - - call codes_close_file(ifile) + call codes_close_file(ifile) end program keys_iterator diff --git a/examples/F90/multi_fortran.f90 b/examples/F90/multi_fortran.f90 index f8ecd3f40..b51fc14e2 100644 --- a/examples/F90/multi_fortran.f90 +++ b/examples/F90/multi_fortran.f90 @@ -14,53 +14,53 @@ ! ! program multi - use eccodes - implicit none + use eccodes + implicit none - integer :: iret - integer(kind = 4) :: parameterCategory,parameterNumber,discipline - integer :: ifile,igrib + integer :: iret + integer(kind=4) :: parameterCategory, parameterNumber, discipline + integer :: ifile, igrib - call codes_open_file(ifile, '../../data/multi.grib2','r') + call codes_open_file(ifile, '../../data/multi.grib2', 'r') - ! turn on support for multi fields messages */ - call codes_grib_multi_support_on() + ! turn on support for multi fields messages */ + call codes_grib_multi_support_on() - ! turn off support for multi fields messages */ - !call codes_grib_multi_support_off() + ! turn off support for multi fields messages */ + !call codes_grib_multi_support_off() - call codes_grib_new_from_file(ifile,igrib) - ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib) + ! Loop on all the messages in a file. - do while (igrib .ne. -1) + do while (igrib .ne. -1) - ! get as a integer*4 - call codes_get(igrib,'discipline',discipline) - write(*,*) 'discipline=',discipline + ! get as a integer*4 + call codes_get(igrib, 'discipline', discipline) + write (*, *) 'discipline=', discipline - ! get as a integer*4 - call codes_get(igrib,'parameterCategory', & - parameterCategory) - write(*,*) 'parameterCategory=',parameterCategory + ! get as a integer*4 + call codes_get(igrib, 'parameterCategory', & + parameterCategory) + write (*, *) 'parameterCategory=', parameterCategory - ! get as a integer*4 - call codes_get(igrib,'parameterNumber', & - parameterNumber) - write(*,*) 'parameterNumber=',parameterNumber + ! get as a integer*4 + call codes_get(igrib, 'parameterNumber', & + parameterNumber) + write (*, *) 'parameterNumber=', parameterNumber - if ( discipline .eq. 0 .and. parameterCategory .eq. 2) then - if (parameterNumber .eq. 2) then - write(*,*) "-------- u -------" - endif - if (parameterNumber .eq. 3) then - write(*,*) "-------- v -------" - endif - endif + if (discipline .eq. 0 .and. parameterCategory .eq. 2) then + if (parameterNumber .eq. 2) then + write (*, *) "-------- u -------" + end if + if (parameterNumber .eq. 3) then + write (*, *) "-------- v -------" + end if + end if - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) - end do - call codes_close_file(ifile) + end do + call codes_close_file(ifile) end program multi diff --git a/examples/F90/new_from_file.f90 b/examples/F90/new_from_file.f90 index a80010f4b..d1eecf272 100644 --- a/examples/F90/new_from_file.f90 +++ b/examples/F90/new_from_file.f90 @@ -9,33 +9,32 @@ ! ! program new_from_file -use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: count1=0 + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: count1 = 0 - ! Message identifier. - integer :: igrib + ! Message identifier. + integer :: igrib - ifile=5 + ifile = 5 - call codes_open_file(ifile,'../../data/collection.grib1','r') + call codes_open_file(ifile, '../../data/collection.grib1', 'r') - ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib, iret) + ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) - do while (iret==CODES_SUCCESS) - count1=count1+1 - print *, "===== Message #",count1 - call codes_grib_new_from_file(ifile,igrib, iret) + do while (iret == CODES_SUCCESS) + count1 = count1 + 1 + print *, "===== Message #", count1 + call codes_grib_new_from_file(ifile, igrib, iret) - end do - if (iret /= CODES_END_OF_FILE) then - call codes_check(iret,'new_from_file','') - endif + end do + if (iret /= CODES_END_OF_FILE) then + call codes_check(iret, 'new_from_file', '') + end if - - call codes_close_file(ifile) + call codes_close_file(ifile) end program diff --git a/examples/F90/precision_fortran.f90 b/examples/F90/precision_fortran.f90 index 7481140b6..4a64abf43 100644 --- a/examples/F90/precision_fortran.f90 +++ b/examples/F90/precision_fortran.f90 @@ -11,82 +11,82 @@ ! ! program precision - use eccodes - implicit none - integer(kind = 4) :: size - integer :: infile,outfile - integer :: igrib - real(kind = 8), dimension(:), allocatable :: values1 - real(kind = 8), dimension(:), allocatable :: values2 - real(kind = 8) :: maxa,a,maxv,minv,maxr,r - integer( kind = 4) :: decimalPrecision,bitsPerValue1,bitsPerValue2 - integer :: i, iret + use eccodes + implicit none + integer(kind=4) :: size + integer :: infile, outfile + integer :: igrib + real(kind=8), dimension(:), allocatable :: values1 + real(kind=8), dimension(:), allocatable :: values2 + real(kind=8) :: maxa, a, maxv, minv, maxr, r + integer(kind=4) :: decimalPrecision, bitsPerValue1, bitsPerValue2 + integer :: i, iret - call codes_open_file(infile, & - '../../data/regular_latlon_surface_constant.grib1','r') + call codes_open_file(infile, & + '../../data/regular_latlon_surface_constant.grib1', 'r') - call codes_open_file(outfile, & - '../../data/regular_latlon_surface_prec.grib1','w') + call codes_open_file(outfile, & + '../../data/regular_latlon_surface_prec.grib1', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! bitsPerValue before changing the packing parameters - call codes_get(igrib,'bitsPerValue',bitsPerValue1) + ! bitsPerValue before changing the packing parameters + call codes_get(igrib, 'bitsPerValue', bitsPerValue1) - ! get the size of the values array - call codes_get_size(igrib,"values",size) + ! get the size of the values array + call codes_get_size(igrib, "values", size) - allocate(values1(size), stat=iret) - allocate(values2(size), stat=iret) - ! get data values before changing the packing parameters*/ - call codes_get(igrib,"values",values1) + allocate (values1(size), stat=iret) + allocate (values2(size), stat=iret) + ! get data values before changing the packing parameters*/ + call codes_get(igrib, "values", values1) - ! setting decimal precision=2 means that 2 decimal digits - ! are preserved when packing. - decimalPrecision=2 - call codes_set(igrib,"setDecimalPrecision", & - decimalPrecision) + ! setting decimal precision=2 means that 2 decimal digits + ! are preserved when packing. + decimalPrecision = 2 + call codes_set(igrib, "setDecimalPrecision", & + decimalPrecision) - ! bitsPerValue after changing the packing parameters - call codes_get(igrib,"bitsPerValue",bitsPerValue2) + ! bitsPerValue after changing the packing parameters + call codes_get(igrib, "bitsPerValue", bitsPerValue2) - ! get data values after changing the packing parameters - call codes_get(igrib,"values",values2) + ! get data values after changing the packing parameters + call codes_get(igrib, "values", values2) - ! computing error - maxa=0 - maxr=0 - maxv=values2(1) - minv=maxv - do i=1,size - a=abs(values2(i)-values1(i)) - if ( values2(i) .gt. maxv ) maxv=values2(i) - if ( values2(i) .lt. maxv ) minv=values2(i) - if ( values2(i) .ne. 0 ) then - r=abs((values2(i)-values1(i))/values2(i)) - endif - if ( a .gt. maxa ) maxa=a - if ( r .gt. maxr ) maxr=r - enddo - write(*,*) "max absolute error = ",maxa - write(*,*) "max relative error = ",maxr - write(*,*) "min value = ",minv - write(*,*) "max value = ",maxv + ! computing error + maxa = 0 + maxr = 0 + maxv = values2(1) + minv = maxv + do i = 1, size + a = abs(values2(i) - values1(i)) + if (values2(i) .gt. maxv) maxv = values2(i) + if (values2(i) .lt. maxv) minv = values2(i) + if (values2(i) .ne. 0) then + r = abs((values2(i) - values1(i))/values2(i)) + end if + if (a .gt. maxa) maxa = a + if (r .gt. maxr) maxr = r + end do + write (*, *) "max absolute error = ", maxa + write (*, *) "max relative error = ", maxr + write (*, *) "min value = ", minv + write (*, *) "max value = ", maxv - write(*,*) "old number of bits per value=",bitsPerValue1 - write(*,*) "new number of bits per value=",bitsPerValue2 + write (*, *) "old number of bits per value=", bitsPerValue1 + write (*, *) "new number of bits per value=", bitsPerValue2 - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) - deallocate(values1) - deallocate(values2) + deallocate (values1) + deallocate (values2) end program precision diff --git a/examples/F90/print_data_fortran.f90 b/examples/F90/print_data_fortran.f90 index 731df8947..8283637df 100644 --- a/examples/F90/print_data_fortran.f90 +++ b/examples/F90/print_data_fortran.f90 @@ -13,41 +13,41 @@ ! ! program print_data_fortran -use eccodes -implicit none -integer :: ifile -integer :: igrib -integer :: i -real(kind=8), dimension(:), allocatable :: values -real(kind=8) :: average -real(kind=8) :: max -real(kind=8) :: min + use eccodes + implicit none + integer :: ifile + integer :: igrib + integer :: i + real(kind=8), dimension(:), allocatable :: values + real(kind=8) :: average + real(kind=8) :: max + real(kind=8) :: min - call codes_open_file(ifile, & - '../../data/constant_field.grib1','r') + call codes_open_file(ifile, & + '../../data/constant_field.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib) - call codes_get(igrib,'values',values) + call codes_get(igrib, 'values', values) - do i=1,size(values) - write(*,*)' ',i,values(i) - enddo + do i = 1, size(values) + write (*, *) ' ', i, values(i) + end do - write(*,*)size(values),' values found ' + write (*, *) size(values), ' values found ' - call codes_get(igrib,'max',max) - write(*,*) 'max=',max - call codes_get(igrib,'min',min) - write(*,*) 'min=',min - call codes_get(igrib,'average',average) - write(*,*) 'average=',average + call codes_get(igrib, 'max', max) + write (*, *) 'max=', max + call codes_get(igrib, 'min', min) + write (*, *) 'min=', min + call codes_get(igrib, 'average', average) + write (*, *) 'average=', average - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(ifile) + call codes_close_file(ifile) - deallocate(values) + deallocate (values) end program print_data_fortran diff --git a/examples/F90/read_from_file.f90 b/examples/F90/read_from_file.f90 index 112d19f02..3ea16ea9f 100644 --- a/examples/F90/read_from_file.f90 +++ b/examples/F90/read_from_file.f90 @@ -10,88 +10,88 @@ ! 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 - 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) + 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_check(iret,'read_from_file','') - endif - 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 - 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) + 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_check(iret,'read_from_file','') - endif - 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 diff --git a/examples/F90/set_fortran.f90 b/examples/F90/set_fortran.f90 index d976c1256..7e3f4ad2f 100644 --- a/examples/F90/set_fortran.f90 +++ b/examples/F90/set_fortran.f90 @@ -10,49 +10,49 @@ ! ! program set - use eccodes - implicit none + use eccodes + implicit none - integer(kind = 4) :: centre - integer(kind = 4) :: int_value - character(len = 10) :: string_value - character(len = 20) :: string_centre - integer :: infile,outfile - integer :: igrib + integer(kind=4) :: centre + integer(kind=4) :: int_value + character(len=10) :: string_value + character(len=20) :: string_centre + integer :: infile, outfile + integer :: igrib - infile=5 - outfile=6 + infile = 5 + outfile = 6 - call codes_open_file(infile, & - '../../data/regular_latlon_surface_constant.grib1','r') + call codes_open_file(infile, & + '../../data/regular_latlon_surface_constant.grib1', 'r') - call codes_open_file(outfile, & - '../../data/out.grib1','w') + call codes_open_file(outfile, & + '../../data/out.grib1', 'w') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! set centre as a long */ - centre=80 - call codes_set(igrib,'centre',centre) + ! set centre as a long */ + centre = 80 + call codes_set(igrib, 'centre', centre) - ! get centre as a integer*4 - call codes_get(igrib,'centre',int_value) - write(*,*) 'centre=',int_value + ! get centre as a integer*4 + call codes_get(igrib, 'centre', int_value) + write (*, *) 'centre=', int_value - ! get centre as a string - call codes_get(igrib,'centre',string_value) - string_centre='centre='//string_value - write(*,*) string_centre + ! get centre as a string + call codes_get(igrib, 'centre', string_value) + string_centre = 'centre='//string_value + write (*, *) string_centre - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) end program set diff --git a/examples/F90/set_missing_fortran.f90 b/examples/F90/set_missing_fortran.f90 index afb1cbd73..17379f2c8 100644 --- a/examples/F90/set_missing_fortran.f90 +++ b/examples/F90/set_missing_fortran.f90 @@ -10,34 +10,34 @@ ! ! program set - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib - infile=5 - outfile=6 + infile = 5 + outfile = 6 - call codes_open_file(infile, & - '../../data/reduced_gaussian_pressure_level.grib2','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_pressure_level.grib2', 'r') - call codes_open_file(outfile, & - 'out_surface_level.grib2','w') + call codes_open_file(outfile, & + 'out_surface_level.grib2', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_set(igrib,'typeOfFirstFixedSurface','sfc') - call codes_set_missing(igrib,'scaleFactorOfFirstFixedSurface') - call codes_set_missing(igrib,'scaledValueOfFirstFixedSurface') + call codes_set(igrib, 'typeOfFirstFixedSurface', 'sfc') + call codes_set_missing(igrib, 'scaleFactorOfFirstFixedSurface') + call codes_set_missing(igrib, 'scaledValueOfFirstFixedSurface') - call codes_write(igrib,outfile) + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) end program set