From 128d233f3f553ba26708f84147e95648b6dc5607 Mon Sep 17 00:00:00 2001 From: Shahram Najm Date: Tue, 29 Mar 2016 15:47:55 +0100 Subject: [PATCH] ECC-237: eccodes interface incompatible with grib_api (allocatable) --- examples/F90/CMakeLists.txt | 7 ++ examples/F90/grib_print_data.f90 | 11 +- examples/F90/grib_print_data.sh | 3 +- examples/F90/grib_print_data_static.f90 | 59 ++++++++++ fortran/eccodes_f90_tail.f90 | 149 ++++++++++++++++++++++-- fortran/grib_f90_tail.f90 | 110 +++-------------- 6 files changed, 226 insertions(+), 113 deletions(-) create mode 100644 examples/F90/grib_print_data_static.f90 diff --git a/examples/F90/CMakeLists.txt b/examples/F90/CMakeLists.txt index 5ee396bef..efce601af 100644 --- a/examples/F90/CMakeLists.txt +++ b/examples/F90/CMakeLists.txt @@ -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 diff --git a/examples/F90/grib_print_data.f90 b/examples/F90/grib_print_data.f90 index e051e6141..2a2ed6153 100644 --- a/examples/F90/grib_print_data.f90 +++ b/examples/F90/grib_print_data.f90 @@ -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) diff --git a/examples/F90/grib_print_data.sh b/examples/F90/grib_print_data.sh index c8015acda..d9bf013d5 100755 --- a/examples/F90/grib_print_data.sh +++ b/examples/F90/grib_print_data.sh @@ -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' diff --git a/examples/F90/grib_print_data_static.f90 b/examples/F90/grib_print_data_static.f90 new file mode 100644 index 000000000..3f1d7b37d --- /dev/null +++ b/examples/F90/grib_print_data_static.f90 @@ -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 diff --git a/fortran/eccodes_f90_tail.f90 b/fortran/eccodes_f90_tail.f90 index f516a9203..cceea7a93 100644 --- a/fortran/eccodes_f90_tail.f90 +++ b/fortran/eccodes_f90_tail.f90 @@ -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 ! diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index adaa4bdbc..8e67cc5d9 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -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