core
/
eccodes
mirror of https://github.com/ecmwf/eccodes.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

ECC-80: Add examples/tests for F90

This commit is contained in:
Shahram Najm 2015-03-12 16:28:31 +00:00
parent d78f28c1db
commit b3f8f4e573
9 changed files with 93 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
examples/F90/CMakeLists.txt
View File

@ -38,7 +38,7 @@ list( APPEND tests
bufr_print_data
bufr_set_keys
bufr_subset
# get_product_kind
get_product_kind
)
# Simplify tests: no need to build executable and then test. All in one

2
examples/F90/Makefile.am
View File

@ -5,7 +5,7 @@ TESTS = copy_message.sh get.sh get_data.sh get_pl.sh get_pv.sh keys_iterator.sh
nearest.sh precision.sh multi_write.sh multi.sh print_data.sh set.sh set_bitmap.sh set_missing.sh \
set_pv.sh samples.sh count_messages.sh read_message.sh read_from_file.sh index.sh get_set_uuid.sh \
bufr_attributes.sh bufr_clone.sh bufr_expanded.sh bufr_get_keys.sh bufr_print_header.sh bufr_print_data.sh bufr_set_keys.sh \
bufr_keys_iterator.sh bufr_subset.sh
bufr_keys_iterator.sh bufr_subset.sh get_product_kind.sh
noinst_PROGRAMS = f_index f_copy_message f_get f_get_data f_get_pl f_get_pv f_keys_iterator \
f_multi_write f_multi f_nearest f_precision f_print_data f_set f_set_bitmap f_set_missing \

21
examples/F90/get_product_kind.sh Executable file
View File

@ -0,0 +1,21 @@
#!/bin/sh
# Copyright 2005-2015 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.
#
. ./include.sh
label="get_product_kind_f"
fTmp=${label}.tmp
# Create a file containing both GRIB and BUFR messages
cat ${data_dir}/sample.grib2 ${data_dir}/bufr/syno_multi.bufr >$fTmp
${examples_dir}/f_get_product_kind $fTmp >/dev/null 2>&1
rm -f ${fTmp}

16
fortran/eccodes_f90_tail.f90
View File

@ -517,11 +517,23 @@ subroutine codes_new_from_file (ifile, gribid , product_kind, status)
else if (product_kind == CODES_PRODUCT_BUFR) then
call codes_bufr_new_from_file ( ifile, gribid , status)
else
! CODES_PRODUCT_ANY - Not yet implemented
call grib_check(CODES_NOT_IMPLEMENTED,'codes_new_from_file','invalid_product_kind')
if (product_kind /= CODES_PRODUCT_ANY) then
call grib_check(CODES_INTERNAL_ERROR,'codes_new_from_file','invalid_product_kind')
end if
call codes_any_new_from_file ( ifile, gribid , status)
end if
end subroutine codes_new_from_file
!
subroutine codes_any_new_from_file ( ifile, id , status)
integer(kind=kindOfInt),intent(in) :: ifile
integer(kind=kindOfInt),intent(out) :: id
integer(kind=kindOfInt),optional,intent(out) :: status
integer(kind=kindOfInt) :: iret
call any_new_from_file ( ifile, id , status)
end subroutine codes_any_new_from_file
!
subroutine codes_grib_new_from_file ( ifile, gribid , status)
integer(kind=kindOfInt),intent(in) :: ifile

1
fortran/eccodes_visibility.h
View File

@ -12,6 +12,7 @@ public :: codes_keys_iterator_get_name, &
codes_keys_iterator_rewind
public :: codes_new_from_message, &
codes_new_from_samples, codes_new_from_file, &
codes_any_new_from_file, &
codes_grib_new_from_file, codes_bufr_new_from_file, &
codes_read_from_file,codes_headers_only_new_from_file
public :: codes_release

1
fortran/grib_api_externals.h
View File

@ -16,6 +16,7 @@ integer, external :: grib_f_new_from_message, &
grib_f_new_from_message_copy, &
grib_f_new_from_samples, &
grib_f_read_any_from_file, &
any_f_new_from_file, &
grib_f_new_from_file, &
bufr_f_new_from_file, &
grib_f_headers_only_new_from_file

25
fortran/grib_f90_tail.f90
View File

@ -1291,7 +1291,17 @@
call grib_check(iret,'grib_new_from_file','')
endif
end subroutine grib_new_from_file
!! TODO: temporary
!> Load in memory a BUFR message from a file.
!>
!> The message can be accessed through its bufrid and it will be available\n
!> until @ref codes_release is called.\n
!>
!> \b Examples: \ref get.f90 "get.f90"
!>
!> @param ifile id of the file opened with @ref codes_open_file
!> @param bufrid id of the BUFR loaded in memory
!> @param status GRIB_SUCCESS if OK, GRIB_END_OF_FILE at the end of file, or error code
subroutine bufr_new_from_file ( ifile, bufrid , status)
integer(kind=kindOfInt),intent(in) :: ifile
integer(kind=kindOfInt),intent(out) :: bufrid
@ -1306,6 +1316,19 @@
endif
end subroutine bufr_new_from_file
subroutine any_new_from_file ( ifile, id , status)
integer(kind=kindOfInt),intent(in) :: ifile
integer(kind=kindOfInt),intent(out) :: id
integer(kind=kindOfInt),optional,intent(out) :: status
integer(kind=kindOfInt) :: iret
iret=any_f_new_from_file( ifile, id )
if (present(status)) then
status = iret
else
call grib_check(iret,'any_new_from_file','')
endif
end subroutine any_new_from_file
!> Create a new message in memory from a character array containting the coded message.

26
fortran/grib_fortran.c
View File

@ -1313,6 +1313,32 @@ int grib_f_count_in_file__(int* fid,int* n) {
return grib_f_count_in_file(fid,n);
}
/*****************************************************************************/
int any_f_new_from_file_(int* fid, int* gid){
int err = 0;
FILE* f = get_file(*fid);
grib_handle *h = NULL;
if(f){
h = codes_handle_new_from_file(0,f,PRODUCT_ANY,&err);
if(h){
push_handle(h,gid);
return GRIB_SUCCESS;
} else {
*gid=-1;
return GRIB_END_OF_FILE;
}
}
*gid=-1;
return GRIB_INVALID_FILE;
}
int any_f_new_from_file__(int* fid, int* gid){
return any_f_new_from_file_( fid, gid);
}
int any_f_new_from_file(int* fid, int* gid){
return any_f_new_from_file_( fid, gid);
}
/*****************************************************************************/
int bufr_f_new_from_file_(int* fid, int* gid){
int err = 0;

4
fortran/grib_fortran_prototypes.h
View File

@ -110,6 +110,10 @@ int grib_f_count_in_file(int *fid, int *n);
int grib_f_count_in_file_(int *fid, int *n);
int grib_f_count_in_file__(int *fid, int *n);
int any_f_new_from_file_(int *fid, int *gid);
int any_f_new_from_file__(int *fid, int *gid);
int any_f_new_from_file(int *fid, int *gid);
int grib_f_new_from_file_(int *fid, int *gid);
int grib_f_new_from_file__(int *fid, int *gid);
int grib_f_new_from_file(int *fid, int *gid);