Merge branch 'develop' of ssh://software.ecmwf.int:7999/eccodes/eccodes into develop

fortran/eccodes_f90_tail.f90

@@ -954,6 +954,53 @@ subroutine codes_new_from_file (ifile, msgid , product_kind, status)
     end if
 end subroutine codes_new_from_file
 
+  !> Scan a file to search for messages without decoding.
+  !>
+  !> @param ifile     id of the file opened with @ref codes_open_file
+  !> @param nmessages number of messages found
+  !> @param status    CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code
+subroutine codes_any_scan_file ( ifile, nmessages , status)
+    integer(kind=kindOfInt),intent(in)              :: ifile
+    integer(kind=kindOfInt),intent(out)          :: nmessages
+    integer(kind=kindOfInt)                       :: iret
+    integer(kind=kindOfInt),optional,intent(out)    :: status
+
+    iret=any_f_scan_file ( ifile, nmessages)
+    if (present(status)) then
+      status = iret
+    else
+      call grib_check(iret,'any_f_scan_file','')
+    endif
+
+end subroutine codes_any_scan_file 
+
+  !> Decode message from scanned file. This function provides direct access to the n-th message in a file.
+  !> A call to codes_any_scan_file must precede a call to this function. The file needs to be scanned to prepare
+  !> direct access by rank.
+  !>
+  !> The message can be accessed through its msgid and it will be available\n
+  !> until @ref codes_release is called.\n
+  !>
+  !> @param ifile     id of the file opened with @ref codes_open_file
+  !> @param nmsg      n-th message in the file to be read
+  !> @param msgid     id of the message loaded in memory
+  !> @param status    CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code
+subroutine codes_any_new_from_scanned_file ( ifile, nmsg, msgid , status)
+    integer(kind=kindOfInt),intent(in)              :: ifile
+    integer(kind=kindOfInt),intent(in)              :: nmsg
+    integer(kind=kindOfInt),intent(out)             :: msgid
+    integer(kind=kindOfInt)                       :: iret
+    integer(kind=kindOfInt),optional,intent(out)    :: status
+
+    iret=any_f_new_from_scanned_file( ifile, nmsg, msgid )
+    if (present(status)) then
+      status = iret
+    else
+      call grib_check(iret,'any_f_new_from_scanned_file','')
+    endif
+
+end subroutine codes_any_new_from_scanned_file 
+
   !> Load in memory all messages from a file without decoding.
   !>
   !> @param ifile     id of the file opened with @ref codes_open_file

fortran/grib_api_externals.h

@@ -27,6 +27,8 @@ integer, external :: grib_f_new_from_message, &
                      any_f_new_from_file, &
                      any_f_load_all_from_file, &
                      any_f_new_from_loaded, &
+                     any_f_scan_file, &
+                     any_f_new_from_scanned_file, &
                      codes_f_clear_loaded_from_file, &
                      grib_f_new_from_file, &
                      bufr_f_new_from_file, &

fortran/grib_fortran.c

@@ -35,6 +35,7 @@
 static pthread_once_t once  = PTHREAD_ONCE_INIT;
 static pthread_mutex_t handle_mutex = PTHREAD_MUTEX_INITIALIZER;
 static pthread_mutex_t index_mutex = PTHREAD_MUTEX_INITIALIZER;
+static pthread_mutex_t read_mutex = PTHREAD_MUTEX_INITIALIZER;
 static pthread_mutex_t multi_handle_mutex = PTHREAD_MUTEX_INITIALIZER;
 static pthread_mutex_t iterator_mutex = PTHREAD_MUTEX_INITIALIZER;
 static pthread_mutex_t keys_iterator_mutex = PTHREAD_MUTEX_INITIALIZER;
@@ -46,6 +47,7 @@ static void init() {
     pthread_mutexattr_settype(&attr,PTHREAD_MUTEX_RECURSIVE);
     pthread_mutex_init(&handle_mutex,&attr);
     pthread_mutex_init(&index_mutex,&attr);
+    pthread_mutex_init(&read_mutex,&attr);
     pthread_mutex_init(&multi_handle_mutex,&attr);
     pthread_mutex_init(&iterator_mutex,&attr);
     pthread_mutex_init(&keys_iterator_mutex,&attr);
@@ -141,6 +143,12 @@ struct l_binary_message {
     void* data;
 };
 
+typedef struct l_message_info l_message_info;
+struct l_message_info {
+    off_t offset;
+    size_t size;
+};
+
 static l_grib_handle* handle_set = NULL;
 static l_grib_index* index_set = NULL;
 static l_grib_multi_handle* multi_handle_set = NULL;
@@ -149,6 +157,7 @@ static l_grib_iterator* iterator_set = NULL;
 static l_grib_keys_iterator* keys_iterator_set = NULL;
 static l_bufr_keys_iterator* bufr_keys_iterator_set = NULL;
 static grib_oarray* binary_messages = NULL;
+static grib_oarray* info_messages = NULL;
 
 static char* cast_char(char* buf, char* fortstr,int len)
 {
@@ -1628,6 +1637,83 @@ int grib_f_copy_namespace(int* gidsrc,char* name,int* giddest,int len){
     return grib_f_copy_namespace_(gidsrc,name,giddest,len);
 }
 
+/*****************************************************************************/
+int any_f_scan_file(int* fid,int* n) {
+    int err = 0;
+    off_t offset=0;
+    void *data = NULL;
+    size_t olen = 0;
+    l_message_info* msg=0;
+    FILE* f = get_file(*fid);
+    grib_context* c=grib_context_get_default();
+
+    /* this needs a callback to a destructor*/
+    /* grib_oarray_delete_content(c,binary_messages); */
+
+    grib_oarray_delete(c,info_messages);
+    info_messages=grib_oarray_new(c,1000,1000);
+
+    if (f) {
+      while (err!=GRIB_END_OF_FILE) {
+        data = wmo_read_any_from_file_malloc ( f, 0,&olen,&offset,&err );
+        msg=(l_message_info*)grib_context_malloc_clear(c,sizeof(l_message_info));
+        msg->offset=offset;
+        msg->size=olen;
+
+        if (err==0 && data) grib_oarray_push(c,info_messages,msg);
+        grib_context_free(c,data);
+      }
+      if (err==GRIB_END_OF_FILE) err=0;
+    }
+    *n=info_messages->n;
+    return err;
+}
+int any_f_scan_file_(int* fid,int* n) {
+    return any_f_scan_file(fid,n);
+}
+int any_f_scan_file__(int* fid,int* n) {
+    return any_f_scan_file(fid,n);
+}
+
+int any_f_new_from_scanned_file(int* fid,int* msgid,int* gid)
+{
+    grib_handle *h = NULL;
+    grib_context* c=grib_context_get_default();
+    int err=0;
+    FILE* f = get_file(*fid);
+
+    /* fortran convention of 1 based index*/
+    const int n=*msgid-1;
+
+    l_message_info* msg=grib_oarray_get(info_messages,n);
+
+    if (msg && f) {
+    GRIB_MUTEX_INIT_ONCE(&once,&init);
+    GRIB_MUTEX_LOCK(&read_mutex);
+      fseeko(f,msg->offset,SEEK_SET);
+      h=any_new_from_file (c,f,&err);
+    GRIB_MUTEX_UNLOCK(&read_mutex);
+    }
+    if (err) return 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_scanned_file_(int* fid,int* msgid,int* gid){
+  return any_f_new_from_scanned_file(fid,msgid,gid);
+}
+int any_f_new_from_scanned_file__(int* fid,int* msgid,int* gid){
+  return any_f_new_from_scanned_file(fid,msgid,gid);
+}
+
 /*****************************************************************************/
 int any_f_load_all_from_file(int* fid,int* n) {
     int err = 0;

fortran/grib_fortran_prototypes.h

@@ -141,6 +141,14 @@ 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 any_f_scan_file_(int* fid,int* n);
+int any_f_scan_file__(int* fid,int* n);
+int any_f_scan_file(int* fid,int* n);
+
+int any_f_new_from_scanned_file_(int* fid,int* msgid,int* gid);
+int any_f_new_from_scanned_file__(int* fid,int* msgid,int* gid);
+int any_f_new_from_scanned_file(int* fid,int* msgid,int* gid);
+
 int any_f_load_all_from_file_(int* fid,int* n);
 int any_f_load_all_from_file__(int* fid,int* n);
 int any_f_load_all_from_file(int* fid,int* n);