Merge branch 'develop' into hotfix/mathomp4/fix-spack-build

CHANGELOG.md

@@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Added
 
+- Add glob function in sampler code, supporting wild character, e.g., filename template = amsr2_gcom-w1.%y4%m2%d2T%h2%n2*.nc4
+- Checked resource for o-server. It quits if the numer requested is inconsistent with being used
 - Replace local HorzIJIndex sear with the GlobalHorzIJindex search
 - Change grd_is_ok function to avoid collective call
 - Allow fields with ungridded dimension and bundles to be created in ExtDataDriver.x

base/CMakeLists.txt

@@ -47,7 +47,7 @@ set (srcs
   ESMF_CFIOPtrVectorMod.F90
   CFIOCollection.F90                    MAPL_CFIO.F90
   regex_module.F90 StringTemplate.F90 MAPL_SphericalGeometry.F90
-  regex_F.c
+  regex_F.c  MAPL_ObsUtil.c
   c_mapl_locstream_F.c  getrss.c  memuse.c
   Base/Base_Base.F90 Base/Base_Base_implementation.F90
   TimeStringConversion.F90

base/MAPL_ObsUtil.F90

@@ -10,6 +10,7 @@ module MAPL_ObsUtilMod
   use pFIO_FileMetadataMod, only : FileMetadata
   use pFIO_NetCDF4_FileFormatterMod, only : NetCDF4_FileFormatter
   use, intrinsic :: iso_fortran_env, only: REAL32, REAL64
+  use, intrinsic :: iso_c_binding
   implicit none
   integer, parameter :: mx_ngeoval = 60
   ! GRS80 by Moritz
@@ -59,6 +60,18 @@ module MAPL_ObsUtilMod
      module procedure sort_four_arrays_by_time
   end interface sort_multi_arrays_by_time
 
+  interface
+     function f_call_c_glob(search_name, filename, slen) &
+           & result(stat)    bind(C, name="glob_C")
+       use, intrinsic :: iso_c_binding
+       implicit none
+       integer :: stat
+       character (kind=c_char), intent(in) :: search_name(*)
+       character (kind=c_char), intent(out) :: filename(*)
+       integer, intent(inout) :: slen
+     end function f_call_c_glob
+  end interface
+
 contains
 
   subroutine get_obsfile_Tbracket_from_epoch(currTime, &
@@ -546,13 +559,9 @@ function get_filename_from_template_use_index (obsfile_start_time, obsfile_inter
     type(ESMF_TimeInterval) :: dT
     type(ESMF_Time) :: time
     integer :: i, j, u
-
-    character(len=ESMF_MAXSTR) :: file_template_left
-    character(len=ESMF_MAXSTR) :: file_template_right
-    character(len=ESMF_MAXSTR) :: filename_left
-    character(len=ESMF_MAXSTR) :: filename_full
+    logical :: allow_wild_char
     character(len=ESMF_MAXSTR) :: filename2
-    character(len=ESMF_MAXSTR) :: cmd
+
 
     call ESMF_TimeIntervalGet(obsfile_interval, s_r8=dT0_s, rc=status)
     s = dT0_s * f_index
@@ -565,9 +574,20 @@ function get_filename_from_template_use_index (obsfile_start_time, obsfile_inter
 
     ! parse time info
     !
+    allow_wild_char=.true.
+    j= index(file_template, '*')
+    _ASSERT ( j==0 .OR. allow_wild_char, "* is not allowed in template")
     call fill_grads_template ( filename, file_template, &
          experiment_id='', nymd=nymd, nhms=nhms, _RC )
-    inquire(file= trim(filename), EXIST = exist)
+    if (j==0) then
+       ! exact file name
+       inquire(file= trim(filename), EXIST = exist)
+    else
+       ! now filename is:  file*.nc
+       call fglob(filename, filename2, rc=status)
+       exist = (status==0)
+       if (exist) filename=trim(filename2)
+    end if
 
     _RETURN(_SUCCESS)
 
@@ -913,4 +933,22 @@ subroutine test_conversion
 
   end subroutine test_conversion
 
+
+  subroutine fglob(search_name, filename, rc)     ! give the last name
+    character(len=*), intent(in) ::  search_name
+    character(len=*), intent(INOUT) :: filename
+    integer, optional, intent(out)  :: rc
+
+    character(kind=C_CHAR, len=:), allocatable :: c_search_name
+    character(kind=C_CHAR, len=512) :: c_filename
+    integer slen
+
+    c_search_name = trim(search_name)//C_NULL_CHAR
+    rc = f_call_c_glob(c_search_name, c_filename, slen)
+    filename=""
+    if (slen>0) filename(1:slen)=c_filename(1:slen)
+
+    return
+  end subroutine fglob
+
 end module MAPL_ObsUtilMod

base/MAPL_ObsUtil.c

@@ -0,0 +1,32 @@
+#include <stdio.h>
+#include <string.h>
+#include <glob.h>
+
+int glob_C (char*, char*, int*);
+
+int glob_C (char *pattern, char *filename, int *stringlen)
+{
+  glob_t  globlist;
+  int error = 1;
+  int failure = -1;
+  char *s;
+  int MAXLEN = 512;  // set path length limit
+
+  int j = glob( pattern, GLOB_ERR, NULL, &globlist );
+  if ( j == GLOB_NOSPACE || j == GLOB_NOMATCH )
+    return (failure);
+  if ( j == GLOB_ABORTED)
+    return (error);
+
+  int i = 0;
+  for (; globlist.gl_pathv[i] ; i++)
+    // printf("f = %s\n", globlist.gl_pathv[i]);
+    ;
+  s = globlist.gl_pathv[--i];
+  for (i=0; *(s+i) != '\0'; i++)
+    *(filename+i) = *(s+i);
+  *stringlen = i;
+
+  if ( i > MAXLEN ) return error;
+  return 0;
+}

base/ServerManager.F90

@@ -217,6 +217,7 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server
      do i = 1, n_oserver_group
 
         if ( trim(s_name) =='o_server'//trim(i_to_string(i)) ) then
+
            if (oserver_type_ == 'multicomm' ) then
 
               allocate(this%o_server, source = MultiCommServer(this%split_comm%get_subcommunicator(), s_name, npes_out_backend))
@@ -227,11 +228,14 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server
                        npes_out_backend, './pfio_writer.x'))
 
            else if (oserver_type_ == 'multigroup' ) then
-
+ 
               allocate(this%o_server, source = MultiGroupServer(this%split_comm%get_subcommunicator(), s_name, npes_out_backend, &
                                                                 with_profiler=with_profiler, rc=status), stat=stat_alloc)
               _VERIFY(status)
               _VERIFY(stat_alloc)
+              if (nodes_out(i) > 0 .and. this%o_server%node_num /= nodes_out(i)) then
+                 _FAIL("Inconsistent output server number. " // "The requested "//i_to_string(nodes_out(i)) //" nodes for output server is different from available "//i_to_string(this%o_server%node_num)// " nodes")
+              endif
            else
 
               allocate(this%o_server, source = MpiServer(this%split_comm%get_subcommunicator(), s_name, with_profiler=with_profiler, rc=status), stat=stat_alloc)