mirror of https://github.com/ecmwf/eccodes.git
ECC-237: eccodes interface incompatible with grib_api (allocatable)
This commit is contained in:
Shahram Najm
parent
363d3e2b7a
commit
128d233f3f
|
|
@ -81,6 +81,13 @@ ecbuild_add_executable( TARGET eccodes_f_set_gvc
|
|||
LINKER_LANGUAGE Fortran
|
||||
LIBS eccodes_f90 eccodes
|
||||
)
|
||||
ecbuild_add_executable( TARGET eccodes_f_grib_print_data_static
|
||||
NOINSTALL
|
||||
SOURCES grib_print_data_static.f90
|
||||
CONDITION HAVE_FORTRAN
|
||||
LINKER_LANGUAGE Fortran
|
||||
LIBS eccodes_f90 eccodes
|
||||
)
|
||||
|
||||
|
||||
# # Note extra dependency
|
||||
|
|
|
|||
|
|
@ -23,19 +23,18 @@ integer(kind=4) :: numPoints
|
|||
real(kind=8) :: average
|
||||
real(kind=8) :: the_max
|
||||
real(kind=8) :: the_min
|
||||
character(len=256) :: error
|
||||
|
||||
call codes_open_file(ifile, &
|
||||
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
|
||||
! 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
|
||||
! Get the size of the values array
|
||||
call codes_get_size(igrib,'values',numPoints)
|
||||
|
||||
! get data values
|
||||
! Get data values
|
||||
print*, 'number of points ', numPoints
|
||||
allocate(values(numPoints), stat=iret)
|
||||
|
||||
|
|
|
|||
|
|
@ -9,4 +9,5 @@
|
|||
|
||||
. ./include.sh
|
||||
|
||||
${examples_dir}eccodes_f_grib_print_data > /dev/null
|
||||
${examples_dir}eccodes_f_grib_print_data | grep '99200 *values found'
|
||||
${examples_dir}eccodes_f_grib_print_data_static | grep '99200 *values found'
|
||||
|
|
|
|||
|
|
@ -0,0 +1,59 @@
|
|||
! Copyright 2005-2016 ECMWF.
|
||||
!
|
||||
! This software is licensed under the terms of the Apache Licence Version 2.0
|
||||
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
|
||||
!
|
||||
! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by
|
||||
! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
|
||||
!
|
||||
!
|
||||
! Description: prints all the data contained in a GRIB file.
|
||||
! Using the old interface with a STATIC array
|
||||
! rather than the new ALLOCATABLE array
|
||||
!
|
||||
!
|
||||
program print_data
|
||||
use grib_api
|
||||
implicit none
|
||||
integer :: ifile
|
||||
integer :: iret
|
||||
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')
|
||||
|
||||
! 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 data values
|
||||
print*, 'number of points ', numPoints
|
||||
|
||||
call grib_get(igrib,'values',values_static)
|
||||
|
||||
do i=1,numPoints
|
||||
write(*,*)' ',i,values_static(i)
|
||||
enddo
|
||||
|
||||
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_release(igrib)
|
||||
call grib_close_file(ifile)
|
||||
|
||||
end program print_data
|
||||
|
|
@ -828,28 +828,93 @@ subroutine codes_get_string ( gribid, key, value, status )
|
|||
call grib_get_string ( gribid, key, value, status )
|
||||
end subroutine codes_get_string
|
||||
|
||||
!
|
||||
! Note: This function supports the allocatable array attribute
|
||||
! -------------------------------------------------------------
|
||||
subroutine codes_get_int_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
character(len=*), intent(in) :: key
|
||||
integer(kind=kindOfInt), dimension(:),allocatable,intent(inout) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
iret=grib_f_get_int_array ( gribid, key, value , nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
|
||||
call grib_get_int_array ( gribid, key, value, status )
|
||||
end subroutine codes_get_int_array
|
||||
|
||||
!
|
||||
|
||||
! Note: This function supports the allocatable array attribute
|
||||
! -------------------------------------------------------------
|
||||
subroutine codes_get_long_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
integer(kind=kindOfLong), dimension(:),allocatable,intent(inout) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
|
||||
call grib_get_long_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
iret=grib_f_get_long_array ( gribid, key, value , nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
|
||||
end subroutine codes_get_long_array
|
||||
|
||||
!
|
||||
|
|
@ -866,19 +931,51 @@ subroutine codes_get_byte_array ( gribid, key, value, length, status )
|
|||
call grib_get_byte_array ( gribid, key, value, length, status )
|
||||
end subroutine codes_get_byte_array
|
||||
|
||||
!
|
||||
! Note: This function supports the allocatable array attribute
|
||||
! -------------------------------------------------------------
|
||||
subroutine codes_get_real4_array ( gribid, key, value, status)
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
real(kind = kindOfFloat), dimension(:),allocatable, intent(inout) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
|
||||
call grib_get_real4_array ( gribid, key, value, status)
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
iret=grib_f_get_real4_array ( gribid, key, value , nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
end subroutine codes_get_real4_array
|
||||
|
||||
!
|
||||
! Note: This function supports the allocatable array attribute
|
||||
! -------------------------------------------------------------
|
||||
subroutine codes_get_real8_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
|
|
@ -887,7 +984,37 @@ subroutine codes_get_real8_array ( gribid, key, value, status )
|
|||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
|
||||
call grib_get_real8_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
iret=grib_f_get_real8_array ( gribid, key, value, nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
end subroutine codes_get_real8_array
|
||||
|
||||
!
|
||||
|
|
|
|||
|
|
@ -2048,35 +2048,15 @@
|
|||
!> @param status GRIB_SUCCESS if OK, integer value on error
|
||||
subroutine grib_get_int_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
integer(kind=kindOfInt), dimension(:),allocatable,intent(inout) :: value
|
||||
character(len=*), intent(in) :: key
|
||||
integer(kind=kindOfInt), dimension(:), intent(out) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
nb_values = size(value)
|
||||
iret=grib_f_get_int_array ( gribid, key, value , nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
|
|
@ -2100,34 +2080,14 @@
|
|||
subroutine grib_get_long_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
integer(kind = kindOfLong),dimension(:),allocatable,intent(inout) :: value
|
||||
integer(kind = kindOfLong),dimension(:), intent(out) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
nb_values = size(value)
|
||||
iret=grib_f_get_long_array ( gribid, key, value , nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
|
|
@ -2188,40 +2148,20 @@
|
|||
subroutine grib_get_real4_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
real(kind = kindOfFloat), dimension(:),allocatable,intent(inout) :: value
|
||||
real(kind = kindOfFloat), dimension(:), intent(out) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
nb_values = size(value)
|
||||
iret=grib_f_get_real4_array ( gribid, key, value , nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
end subroutine grib_get_real4_array
|
||||
|
||||
|
|
@ -2238,36 +2178,16 @@
|
|||
subroutine grib_get_real8_array ( gribid, key, value, status )
|
||||
integer(kind=kindOfInt), intent(in) :: gribid
|
||||
character(len=*), intent(in) :: key
|
||||
real(kind = kindOfDouble),dimension(:),allocatable,intent(inout) :: value
|
||||
real(kind = kindOfDouble),dimension(:), intent(out) :: value
|
||||
integer(kind=kindOfInt),optional, intent(out) :: status
|
||||
integer(kind=kindOfInt) :: iret
|
||||
integer(kind=kindOfInt) :: nb_values
|
||||
integer(kind=kindOfInt) :: size_value
|
||||
integer(kind=kindOfInt) :: i
|
||||
|
||||
iret=grib_f_get_size_int(gribid,key,nb_values)
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
call grib_check(iret,'grib_get',key)
|
||||
endif
|
||||
return
|
||||
endif
|
||||
if (allocated(value) .eqv. .false.) then
|
||||
allocate(value(nb_values))
|
||||
end if
|
||||
size_value=size(value)
|
||||
nb_values = size(value)
|
||||
iret=grib_f_get_real8_array ( gribid, key, value, nb_values )
|
||||
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
|
||||
do i=2,size_value
|
||||
value(i)=value(1)
|
||||
enddo
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (iret /= 0) then
|
||||
call grib_f_write_on_fail(gribid)
|
||||
endif
|
||||
if (present(status)) then
|
||||
status = iret
|
||||
else
|
||||
|
|
|
|||
Loading…
Reference in New Issue