From 2e0d31080dda0bdd06ae2e1d1d2037498c85e020 Mon Sep 17 00:00:00 2001 From: Jos de Kloe Date: Sat, 29 Feb 2020 15:50:22 +0100 Subject: [PATCH] a collection of changes to ensure the fortran code compiles with gfortran v10.0 --- fortran/eccodes_visibility.h | 7 + fortran/grib_api_externals.h | 110 ++++++++++++++++ fortran/grib_f90_tail.f90 | 64 ++++----- fortran/grib_fortran.c | 126 ++++++++++++++++++ fortran/grib_fortran_kinds.c | 42 +++++- fortran/grib_fortran_prototypes.h | 50 +++++++ fortran/grib_types.f90 | 208 ++++++++++++++++++++++++------ 7 files changed, 527 insertions(+), 80 deletions(-) diff --git a/fortran/eccodes_visibility.h b/fortran/eccodes_visibility.h index ad3cf2fbd..00abeed27 100644 --- a/fortran/eccodes_visibility.h +++ b/fortran/eccodes_visibility.h @@ -36,3 +36,10 @@ public :: codes_index_get,codes_index_select,& codes_index_create,codes_index_get_size,codes_index_release,& codes_grib_util_sections_copy public :: codes_datetime_to_julian,codes_julian_to_datetime,codes_copy_key + +! these public declarations cannot be added in grib_kinds.h +! since if you do that, grib_kinds.h cannot be included +! inside interface statements +public :: kindOfInt, kindOfLong, kindOfSize_t, kindOfSize +public :: kindOfDouble, kindOfFloat, sizeOfInteger, sizeOfInteger2 +public :: sizeOfInteger4, sizeOfReal4, sizeOfReal8 diff --git a/fortran/grib_api_externals.h b/fortran/grib_api_externals.h index 1cafa17c9..ea6adc731 100644 --- a/fortran/grib_api_externals.h +++ b/fortran/grib_api_externals.h @@ -82,3 +82,113 @@ external :: grib_f_check integer, external :: grib_f_util_sections_copy integer, external :: grib_f_set_definitions_path, grib_f_set_samples_path integer, external :: grib_f_julian_to_datetime, grib_f_datetime_to_julian, grib_f_copy_key + +interface + function grib_f_write_file_char(ifile, buffer, ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + character(len=1), dimension(:),intent(in) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_write_file_char + function grib_f_write_file_int4(ifile, buffer, ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + integer(kind=4), dimension(:),intent(in) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_write_file_int4 + function grib_f_write_file_real4(ifile, buffer, ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + real(kind=4), dimension(:),intent(in) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_write_file_real4 + function grib_f_write_file_real8(ifile, buffer, ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + real(kind=8), dimension(:),intent(in) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_write_file_real8 +end interface + +interface + function grib_f_new_from_message_char(gribid, message, size_bytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(out) :: gribid + character(len=1), dimension(:),intent(in) :: message + integer(kind=kindOfSize_t) :: size_bytes + integer(kind=kindOfInt) :: iret + end function grib_f_new_from_message_char + function grib_f_new_from_message_int4(gribid, message, size_bytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(out) :: gribid + integer(kind=4), dimension(:),intent(in) :: message + integer(kind=kindOfSize_t) :: size_bytes + integer(kind=kindOfInt) :: iret + end function grib_f_new_from_message_int4 +end interface + +interface + function grib_f_read_any_from_file_char(ifile,buffer,nbytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + character(len=1),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_any_from_file_char + function grib_f_read_any_from_file_int4(ifile,buffer,nbytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + integer(kind=4),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_any_from_file_int4 + function grib_f_read_any_from_file_real4(ifile,buffer,nbytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + real(kind=4),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_any_from_file_real4 + function grib_f_read_any_from_file_real8(ifile,buffer,nbytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + real(kind=8),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_any_from_file_real8 +end interface + +interface + function grib_f_read_file_char(ifile,buffer,ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + character(len=1),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_file_char + function grib_f_read_file_int4(ifile,buffer,ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + integer(kind=4),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_file_int4 + function grib_f_read_file_real4(ifile,buffer,ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + real(kind=4),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_file_real4 + function grib_f_read_file_real8(ifile,buffer,ibytes) result(iret) + include "grib_kinds.h" + integer(kind=kindOfInt),intent(in) :: ifile + real(kind=8),dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret + end function grib_f_read_file_real8 +end interface diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index 6e73253e1..b24b8bbda 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -530,7 +530,7 @@ subroutine grib_read_bytes_char ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) + iret=grib_f_read_file_char(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -557,7 +557,7 @@ subroutine grib_read_bytes_char_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) + iret=grib_f_read_file_char(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -586,7 +586,7 @@ subroutine grib_read_bytes_int4 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) + iret=grib_f_read_file_int4(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -613,7 +613,7 @@ subroutine grib_read_bytes_int4_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) + iret=grib_f_read_file_int4(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -642,7 +642,7 @@ subroutine grib_read_bytes_real4 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) + iret=grib_f_read_file_real4(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -669,7 +669,7 @@ subroutine grib_read_bytes_real4_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) + iret=grib_f_read_file_real4(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -698,7 +698,7 @@ subroutine grib_read_bytes_real8 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) + iret=grib_f_read_file_real8(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -725,7 +725,7 @@ subroutine grib_read_bytes_real8_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) + iret=grib_f_read_file_real8(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -753,12 +753,12 @@ subroutine grib_read_from_file_int4 ( ifile, buffer, nbytes, status ) integer(kind=kindOfSize_t) :: ibytes integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) + ibytes=int(nbytes,kindOfSize_t) + iret=grib_f_read_any_from_file_int4(ifile,buffer,ibytes) if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then iret = GRIB_MESSAGE_TOO_LARGE endif - nbytes=ibytes + nbytes=int(ibytes,kindOfInt) if (present(status)) then status = iret else @@ -785,7 +785,7 @@ subroutine grib_read_from_file_int4_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) + iret=grib_f_read_any_from_file_int4(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -814,11 +814,11 @@ subroutine grib_read_from_file_real4 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) + iret=grib_f_read_any_from_file_real4(ifile,buffer,ibytes) if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then iret = GRIB_MESSAGE_TOO_LARGE endif - nbytes=ibytes + nbytes=int(ibytes,kindOfInt) if (present(status)) then status = iret else @@ -845,7 +845,7 @@ subroutine grib_read_from_file_real4_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) + iret=grib_f_read_any_from_file_real4(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -874,11 +874,11 @@ subroutine grib_read_from_file_real8 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) + iret=grib_f_read_any_from_file_real8(ifile,buffer,ibytes) if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then iret = GRIB_MESSAGE_TOO_LARGE endif - nbytes=ibytes + nbytes=int(ibytes,kindOfInt) if (present(status)) then status = iret else @@ -905,7 +905,7 @@ subroutine grib_read_from_file_real8_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) + iret=grib_f_read_any_from_file_real8(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -934,11 +934,11 @@ subroutine grib_read_from_file_char ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) + iret=grib_f_read_any_from_file_char(ifile,buffer,ibytes) if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then iret = GRIB_MESSAGE_TOO_LARGE endif - nbytes=ibytes + nbytes=int(ibytes,kindOfInt) if (present(status)) then status = iret else @@ -965,7 +965,7 @@ subroutine grib_read_from_file_char_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) + iret=grib_f_read_any_from_file_char(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -994,7 +994,7 @@ subroutine grib_write_bytes_char ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) + iret=grib_f_write_file_char(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -1021,7 +1021,7 @@ subroutine grib_write_bytes_char_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional,intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) + iret=grib_f_write_file_char(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -1050,7 +1050,7 @@ subroutine grib_write_bytes_int4 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) + iret=grib_f_write_file_int4(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -1077,7 +1077,7 @@ subroutine grib_write_bytes_int4_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional,intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) + iret=grib_f_write_file_int4(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -1106,7 +1106,7 @@ subroutine grib_write_bytes_real4 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) + iret=grib_f_write_file_real4(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -1133,7 +1133,7 @@ subroutine grib_write_bytes_real4_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional,intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) + iret=grib_f_write_file_real4(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -1162,7 +1162,7 @@ subroutine grib_write_bytes_real8 ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt) :: iret ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) + iret=grib_f_write_file_real8(ifile,buffer,ibytes) if (present(status)) then status = iret else @@ -1189,7 +1189,7 @@ subroutine grib_write_bytes_real8_size_t ( ifile, buffer, nbytes, status ) integer(kind=kindOfInt),optional,intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) + iret=grib_f_write_file_real8(ifile,buffer,nbytes) if (present(status)) then status = iret else @@ -1362,7 +1362,7 @@ subroutine grib_new_from_message_char( gribid, message, status ) integer(kind=kindOfInt) :: iret size_bytes=size(message,dim=1) - iret = grib_f_new_from_message ( gribid, message, size_bytes ) + iret = grib_f_new_from_message_char ( gribid, message, size_bytes ) if (present(status)) then status = iret else @@ -1395,7 +1395,7 @@ subroutine grib_new_from_message_int4 ( gribid, message, status ) integer(kind=kindOfInt) :: iret size_bytes=size(message,dim=1)*sizeOfInteger4 - iret = grib_f_new_from_message ( gribid, message, size_bytes ) + iret = grib_f_new_from_message_int4 ( gribid, message, size_bytes ) if (present(status)) then status = iret else @@ -2705,7 +2705,7 @@ subroutine grib_get_message_size_int ( gribid, nbytes, status) if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then iret = GRIB_MESSAGE_TOO_LARGE endif - nbytes = ibytes + nbytes = int(ibytes,kindOfInt) if (iret /= 0) then call grib_f_write_on_fail(gribid) endif diff --git a/fortran/grib_fortran.c b/fortran/grib_fortran.c index 289e2c5b4..86b00bb4a 100644 --- a/fortran/grib_fortran.c +++ b/fortran/grib_fortran.c @@ -948,6 +948,42 @@ int grib_f_read_any_from_file__(int* fid, char* buffer, size_t* nbytes) { int grib_f_read_any_from_file(int* fid, char* buffer, size_t* nbytes) { return grib_f_read_any_from_file_(fid,buffer,nbytes); } +int grib_f_read_any_from_file_char__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_char_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_char(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_int4__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_int4_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_int4(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_real4__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_real4_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_real4(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_real8__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_real8_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} +int grib_f_read_any_from_file_real8(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_any_from_file_(fid,buffer,nbytes); +} /*****************************************************************************/ int grib_f_write_file_(int* fid, char* buffer, size_t* nbytes) { @@ -973,6 +1009,42 @@ int grib_f_write_file__(int* fid, char* buffer, size_t* nbytes) { int grib_f_write_file(int* fid, char* buffer, size_t* nbytes) { return grib_f_write_file_(fid,buffer,nbytes); } +int grib_f_write_file_char__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_char_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_char(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_int4__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_int4_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_int4(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_real4__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_real4_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_real4(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_real8__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_real8_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} +int grib_f_write_file_real8(int* fid, char* buffer, size_t* nbytes) { + return grib_f_write_file_(fid,buffer,nbytes); +} /*****************************************************************************/ int grib_f_read_file_(int* fid, char* buffer, size_t* nbytes) { @@ -998,6 +1070,42 @@ int grib_f_read_file__(int* fid, char* buffer, size_t* nbytes) { int grib_f_read_file(int* fid, char* buffer, size_t* nbytes) { return grib_f_read_file_(fid,buffer,nbytes); } +int grib_f_read_file_char__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_char_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_char(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_int4__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_int4_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_int4(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_real4__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_real4_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_real4(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_real8__(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_real8_(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} +int grib_f_read_file_real8(int* fid, char* buffer, size_t* nbytes) { + return grib_f_read_file_(fid,buffer,nbytes); +} /*****************************************************************************/ int grib_f_open_file_(int* fid, char* name , char* op, int lname, int lop) { @@ -1491,6 +1599,24 @@ int grib_f_new_from_message__(int* gid, void* buffer , size_t* bufsize){ int grib_f_new_from_message(int* gid, void* buffer , size_t* bufsize){ return grib_f_new_from_message_(gid, buffer , bufsize); } +int grib_f_new_from_message_int4__(int* gid, void* buffer , size_t* bufsize){ + return grib_f_new_from_message_(gid, buffer , bufsize); +} +int grib_f_new_from_message_int4_(int* gid, void* buffer , size_t* bufsize){ + return grib_f_new_from_message_(gid, buffer , bufsize); +} +int grib_f_new_from_message_int4(int* gid, void* buffer , size_t* bufsize){ + return grib_f_new_from_message_(gid, buffer , bufsize); +} +int grib_f_new_from_message_char__(int* gid, void* buffer , size_t* bufsize){ + return grib_f_new_from_message_(gid, buffer , bufsize); +} +int grib_f_new_from_message_char_(int* gid, void* buffer , size_t* bufsize){ + return grib_f_new_from_message_(gid, buffer , bufsize); +} +int grib_f_new_from_message_char(int* gid, void* buffer , size_t* bufsize){ + return grib_f_new_from_message_(gid, buffer , bufsize); +} /*****************************************************************************/ int grib_f_new_from_message_copy_(int* gid, void* buffer , size_t* bufsize){ diff --git a/fortran/grib_fortran_kinds.c b/fortran/grib_fortran_kinds.c index 413a0d164..17f55383b 100644 --- a/fortran/grib_fortran_kinds.c +++ b/fortran/grib_fortran_kinds.c @@ -17,42 +17,72 @@ extern "C" { void f_sizeof(void *x,void *y, int *size) { *size=((char*)y)-((char*)x); } -void f_sizeof_(void *x,void *y, int *size) { - *size=((char*)y)-((char*)x); -} -void f_sizeof__(void *x,void *y, int *size) { - *size=((char*)y)-((char*)x); -} +void f_sizeof_(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof__(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_i2_(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_i2__(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_i4_(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_i4__(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_r4_(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_r4__(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_r8_(void *x,void *y, int *size) {f_sizeof(x,y,size);} +void f_sizeof_r8__(void *x,void *y, int *size) {f_sizeof(x,y,size);} void check_double(double *x,double *y,char* ret) { *ret = ((char*)y)-((char*)x) == sizeof(*x) ? 't' : 'f'; } void check_double_(double *x,double *y,char* ret) {check_double(x,y,ret);} void check_double__(double *x,double *y,char* ret) {check_double(x,y,ret);} +void check_double_r4_(double *x,double *y,char* ret) {check_double(x,y,ret);} +void check_double_r4__(double *x,double *y,char* ret) {check_double(x,y,ret);} +void check_double_r8_(double *x,double *y,char* ret) {check_double(x,y,ret);} +void check_double_r8__(double *x,double *y,char* ret) {check_double(x,y,ret);} void check_float(float *x,float *y,char* ret) { *ret = ((char*)y)-((char*)x) == sizeof(*x) ? 't' : 'f'; } void check_float_(float *x,float *y,char* ret) { check_float(x,y,ret); } void check_float__(float *x,float *y,char* ret) { check_float(x,y,ret); } +void check_float_r4_(float *x,float *y,char* ret) { check_float(x,y,ret); } +void check_float_r4__(float *x,float *y,char* ret) { check_float(x,y,ret); } +void check_float_r8_(float *x,float *y,char* ret) { check_float(x,y,ret); } +void check_float_r8__(float *x,float *y,char* ret) { check_float(x,y,ret); } void check_int(int *x,int *y,char* ret) { *ret = ((char*)y)-((char*)x) == sizeof(*x) ? 't' : 'f'; } void check_int_(int *x,int *y,char* ret) { check_int(x,y,ret); } void check_int__(int *x,int *y,char* ret) { check_int(x,y,ret); } +void check_int_i2_(int *x,int *y,char* ret) { check_int(x,y,ret); } +void check_int_i2__(int *x,int *y,char* ret) { check_int(x,y,ret); } +void check_int_i4_(int *x,int *y,char* ret) { check_int(x,y,ret); } +void check_int_i4__(int *x,int *y,char* ret) { check_int(x,y,ret); } +void check_int_i8_(int *x,int *y,char* ret) { check_int(x,y,ret); } +void check_int_i8__(int *x,int *y,char* ret) { check_int(x,y,ret); } void check_long(long *x,long *y,char* ret) { *ret = ((char*)y)-((char*)x) == sizeof(*x) ? 't' : 'f'; } void check_long_(long *x,long *y,char* ret) {check_long(x,y,ret);} void check_long__(long *x,long *y,char* ret) {check_long(x,y,ret);} +void check_long_i2_(long *x,long *y,char* ret) {check_long(x,y,ret);} +void check_long_i2__(long *x,long *y,char* ret) {check_long(x,y,ret);} +void check_long_i4_(long *x,long *y,char* ret) {check_long(x,y,ret);} +void check_long_i4__(long *x,long *y,char* ret) {check_long(x,y,ret);} +void check_long_i8_(long *x,long *y,char* ret) {check_long(x,y,ret);} +void check_long_i8__(long *x,long *y,char* ret) {check_long(x,y,ret);} void check_size_t(size_t *x,size_t *y,char* ret) { *ret = ((char*)y)-((char*)x) == sizeof(*x) ? 't' : 'f'; } void check_size_t_(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} void check_size_t__(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} +void check_size_t_i2_(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} +void check_size_t_i2__(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} +void check_size_t_i4_(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} +void check_size_t_i4__(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} +void check_size_t_i8_(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} +void check_size_t_i8__(size_t *x,size_t *y,char* ret) {check_size_t(x,y,ret);} #ifdef __cplusplus } diff --git a/fortran/grib_fortran_prototypes.h b/fortran/grib_fortran_prototypes.h index 3b7b5b3c6..2c44b0dbc 100644 --- a/fortran/grib_fortran_prototypes.h +++ b/fortran/grib_fortran_prototypes.h @@ -19,12 +19,54 @@ int grib_f_read_any_headers_only_from_file(int *fid, char *buffer, size_t *nbyte int grib_f_read_any_from_file_(int *fid, char *buffer, size_t *nbytes); int grib_f_read_any_from_file__(int *fid, char *buffer, size_t *nbytes); int grib_f_read_any_from_file(int *fid, char *buffer, size_t *nbytes); + +int grib_f_read_any_from_file_char(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_char_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_char__(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_int4(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_int4_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_int4__(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_real4(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_real4_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_real4__(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_real8(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_real8_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_any_from_file_real8__(int *fid, char *buffer, size_t *nbytes); + int grib_f_write_file_(int *fid, char *buffer, size_t *nbytes); int grib_f_write_file__(int *fid, char *buffer, size_t *nbytes); int grib_f_write_file(int *fid, char *buffer, size_t *nbytes); + +int grib_f_write_file_char(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_char_(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_char__(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_int4(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_int4_(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_int4__(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_real4(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_real4_(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_real4__(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_real8(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_real8_(int *fid, char *buffer, size_t *nbytes); +int grib_f_write_file_real8__(int *fid, char *buffer, size_t *nbytes); + int grib_f_read_file_(int *fid, char *buffer, size_t *nbytes); int grib_f_read_file__(int *fid, char *buffer, size_t *nbytes); int grib_f_read_file(int *fid, char *buffer, size_t *nbytes); + +int grib_f_read_file_char(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_char_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_char__(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_int4(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_int4_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_int4__(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_real4(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_real4_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_real4__(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_real8(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_real8_(int *fid, char *buffer, size_t *nbytes); +int grib_f_read_file_real8__(int *fid, char *buffer, size_t *nbytes); + int grib_f_open_file_(int *fid, char *name, char *op, int lname, int lop); int grib_f_open_file__(int *fid, char *name, char *op, int lname, int lop); int grib_f_open_file(int *fid, char *name, char *op, int lname, int lop); @@ -110,6 +152,14 @@ int grib_f_keys_iterator_rewind(int *kiter); int grib_f_new_from_message_(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message__(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message(int *gid, void *buffer, size_t *bufsize); + +int grib_f_new_from_message_char(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_char_(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_char__(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_int4(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_int4_(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_int4__(int *gid, void *buffer, size_t *bufsize); + int grib_f_new_from_message_copy_(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message_copy__(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message_copy(int *gid, void *buffer, size_t *bufsize); diff --git a/fortran/grib_types.f90 b/fortran/grib_types.f90 index d897deaa0..be141fe62 100644 --- a/fortran/grib_types.f90 +++ b/fortran/grib_types.f90 @@ -7,26 +7,45 @@ ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. integer function kind_of_size_t() - integer(2), dimension(2) :: x2 = (/1, 2/) - integer(4), dimension(2) :: x4 = (/1, 2/) - integer(8), dimension(2) :: x8 = (/1, 2/) + implicit none + integer(2), dimension(2) :: x2 = (/1_2, 2_2/) + integer(4), dimension(2) :: x4 = (/1_4, 2_4/) + integer(8), dimension(2) :: x8 = (/1_8, 2_8/) character(len=1) :: ret + interface + subroutine check_size_t_i2(i1,i2,ret) + implicit none + integer(2), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_size_t_i2 + subroutine check_size_t_i4(i1,i2,ret) + implicit none + integer(4), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_size_t_i4 + subroutine check_size_t_i8(i1,i2,ret) + implicit none + integer(8), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_size_t_i8 + end interface + kind_of_size_t=-1 - call check_size_t(x2(1),x2(2),ret) + call check_size_t_i2(x2(1),x2(2),ret) if (ret == 't') then kind_of_size_t=2 return endif - call check_size_t(x4(1),x4(2),ret) + call check_size_t_i4(x4(1),x4(2),ret) if (ret == 't') then kind_of_size_t=4 return endif - call check_size_t(x8(1),x8(2),ret) + call check_size_t_i8(x8(1),x8(2),ret) if (ret == 't') then kind_of_size_t=8 return @@ -35,26 +54,45 @@ integer function kind_of_size_t() end function kind_of_size_t integer function kind_of_long() - integer(2), dimension(2) :: x2 = (/1, 2/) - integer(4), dimension(2) :: x4 = (/1, 2/) - integer(8), dimension(2) :: x8 = (/1, 2/) + implicit none + integer(2), dimension(2) :: x2 = (/1_2, 2_2/) + integer(4), dimension(2) :: x4 = (/1_4, 2_4/) + integer(8), dimension(2) :: x8 = (/1_8, 2_8/) character(len=1) :: ret + interface + subroutine check_long_i2(i1,i2,ret) + implicit none + integer(2), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_long_i2 + subroutine check_long_i4(i1,i2,ret) + implicit none + integer(4), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_long_i4 + subroutine check_long_i8(i1,i2,ret) + implicit none + integer(8), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_long_i8 + end interface + kind_of_long=-1 - call check_long(x2(1),x2(2),ret) + call check_long_i2(x2(1),x2(2),ret) if (ret == 't') then kind_of_long=2 return endif - call check_long(x4(1),x4(2),ret) + call check_long_i4(x4(1),x4(2),ret) if (ret == 't') then kind_of_long=4 return endif - call check_long(x8(1),x8(2),ret) + call check_long_i8(x8(1),x8(2),ret) if (ret == 't') then kind_of_long=8 return @@ -63,26 +101,45 @@ integer function kind_of_long() end function kind_of_long integer function kind_of_int() - integer(2), dimension(2) :: x2 = (/1, 2/) - integer(4), dimension(2) :: x4 = (/1, 2/) - integer(8), dimension(2) :: x8 = (/1, 2/) + implicit none + integer(2), dimension(2) :: x2 = (/1_2, 2_2/) + integer(4), dimension(2) :: x4 = (/1_4, 2_4/) + integer(8), dimension(2) :: x8 = (/1_8, 2_8/) character(len=1) :: ret + interface + subroutine check_int_i2(i1,i2,ret) + implicit none + integer(2), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_int_i2 + subroutine check_int_i4(i1,i2,ret) + implicit none + integer(4), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_int_i4 + subroutine check_int_i8(i1,i2,ret) + implicit none + integer(8), intent(in) :: i1, i2 + character(len=1), intent(out) :: ret + end subroutine check_int_i8 + end interface + kind_of_int=-1 - call check_int(x2(1),x2(2),ret) + call check_int_i2(x2(1),x2(2),ret) if (ret == 't') then kind_of_int=2 return endif - call check_int(x4(1),x4(2),ret) + call check_int_i4(x4(1),x4(2),ret) if (ret == 't') then kind_of_int=4 return endif - call check_int(x8(1),x8(2),ret) + call check_int_i8(x8(1),x8(2),ret) if (ret == 't') then kind_of_int=8 return @@ -91,19 +148,33 @@ integer function kind_of_int() end function kind_of_int integer function kind_of_float() - real(4), dimension(2) :: x4 = (/1., 2./) - real(8), dimension(2) :: x8 = (/1., 2./) + implicit none + real(4), dimension(2) :: x4 = (/1._4, 2._4/) + real(8), dimension(2) :: x8 = (/1._8, 2._8/) character(len=1) :: ret + + interface + subroutine check_float_r4(r1,r2,ret) + implicit none + real(4), intent(in) :: r1, r2 + character(len=1), intent(out) :: ret + end subroutine check_float_r4 + subroutine check_float_r8(r1,r2,ret) + implicit none + real(8), intent(in) :: r1, r2 + character(len=1), intent(out) :: ret + end subroutine check_float_r8 + end interface kind_of_float=-1 - call check_float(x4(1),x4(2),ret) + call check_float_r4(x4(1),x4(2),ret) if (ret == 't') then kind_of_float=4 return endif - call check_float(x8(1),x8(2),ret) + call check_float_r8(x8(1),x8(2),ret) if (ret == 't') then kind_of_float=8 return @@ -112,19 +183,33 @@ integer function kind_of_float() end function kind_of_float integer function kind_of_double() - real(4), dimension(2) :: real4 = (/1., 2./) - real(8), dimension(2) :: real8 = (/1., 2./) + implicit none + real(4), dimension(2) :: real4 = (/1._4, 2._4/) + real(8), dimension(2) :: real8 = (/1._8, 2._8/) character(len=1) :: ret + interface + subroutine check_double_r4(r1,r2,ret) + implicit none + real(4), intent(in) :: r1, r2 + character(len=1), intent(out) :: ret + end subroutine check_double_r4 + subroutine check_double_r8(r1,r2,ret) + implicit none + real(8), intent(in) :: r1, r2 + character(len=1), intent(out) :: ret + end subroutine check_double_r8 + end interface + kind_of_double=-1 - call check_double(real4(1),real4(2),ret) + call check_double_r4(real4(1),real4(2),ret) if (ret == 't') then kind_of_double=4 return endif - call check_double(real8(1),real8(2),ret) + call check_double_r8(real8(1),real8(2),ret) if (ret == 't') then kind_of_double=8 return @@ -133,29 +218,68 @@ integer function kind_of_double() end function kind_of_double program kind_h + implicit none integer :: size integer, dimension(2) :: i integer(kind=2), dimension(2) :: i2 integer(kind=4), dimension(2) :: i4 real(kind=4), dimension(2) :: r4 real(kind=8), dimension(2) :: r8 - - print *,"integer,public,parameter :: kindOfInt=",kind_of_int() - print *,"integer,public,parameter :: kindOfLong=",kind_of_long() - print *,"integer,public,parameter :: kindOfSize_t=",kind_of_size_t() - print *,"integer,public,parameter :: kindOfSize=",kind_of_size_t() - print *,"integer,public,parameter :: kindOfDouble=",kind_of_double() - print *,"integer,public,parameter :: kindOfFloat=",kind_of_float() + ! function types + integer :: kind_of_int + integer :: kind_of_long + integer :: kind_of_size_t + integer :: kind_of_double + integer :: kind_of_float + + interface + subroutine f_sizeof(i1,i2,size) + implicit none + integer, intent(in) :: i1, i2 ! default integer + integer, intent(out) :: size + end subroutine f_sizeof + subroutine f_sizeof_i2(i1,i2,size) + implicit none + integer(kind=2), intent(in) :: i1, i2 + integer, intent(out) :: size + end subroutine f_sizeof_i2 + subroutine f_sizeof_i4(i1,i2,size) + implicit none + integer(kind=4), intent(in) :: i1, i2 + integer, intent(out) :: size + end subroutine f_sizeof_i4 + subroutine f_sizeof_r4(r1,r2,size) + implicit none + real(kind=4), intent(in) :: r1, r2 + integer, intent(out) :: size + end subroutine f_sizeof_r4 + subroutine f_sizeof_r8(r1,r2,size) + implicit none + real(kind=8), intent(in) :: r1, r2 + integer, intent(out) :: size + end subroutine f_sizeof_r8 + end interface + + ! note: public declarations cannot be added in grib_kinds.h + ! by the following print statements, + ! since if you do that, grib_kinds.h cannot be included + ! inside interface statements + print *,"integer,parameter :: kindOfInt=",kind_of_int() + print *,"integer,parameter :: kindOfLong=",kind_of_long() + print *,"integer,parameter :: kindOfSize_t=",kind_of_size_t() + print *,"integer,parameter :: kindOfSize=",kind_of_size_t() + print *,"integer,parameter :: kindOfDouble=",kind_of_double() + print *,"integer,parameter :: kindOfFloat=",kind_of_float() call f_sizeof(i(1),i(2),size) - print *,"integer,public,parameter :: sizeOfInteger=",size - call f_sizeof(i2(1),i2(2),size) - print *,"integer,public,parameter :: sizeOfInteger2=",size - call f_sizeof(i4(1),i4(2),size) - print *,"integer,public,parameter :: sizeOfInteger4=",size - call f_sizeof(r4(1),r4(2),size) - print *,"integer,public,parameter :: sizeOfReal4=",size - call f_sizeof(r8(1),r8(2),size) - print *,"integer,public,parameter :: sizeOfReal8=",size + print *,"integer,parameter :: sizeOfInteger=",size + call f_sizeof_i2(i2(1),i2(2),size) + print *,"integer,parameter :: sizeOfInteger2=",size + call f_sizeof_i4(i4(1),i4(2),size) + print *,"integer,parameter :: sizeOfInteger4=",size + call f_sizeof_r4(r4(1),r4(2),size) + print *,"integer,parameter :: sizeOfReal4=",size + call f_sizeof_r8(r8(1),r8(2),size) + print *,"integer,parameter :: sizeOfReal8=",size end program kind_h