Auto GitFlow - develop → MAPL-v3 - Add a few first level timer for sampelr code in MAPL_HistoryGridComp.F90

CHANGELOG.md

@@ -9,10 +9,15 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### Added
 
+- If file path length exceeds ESMF_MAXSTR, add _FAIL in subroutine fglob
 - Add GNU UFS-like CI test
 
 ### Changed
 
+- pFIO Clients don't send "Done" message when there is no request
+- Update `components.yaml`
+  - ESMA_cmake v3.45.1
+    - Fix bug in meson detection
 - Updated `checkpoint_simulator` to not create and close file if not writing
 
 ### Fixed
@@ -34,9 +39,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Added
 
 - Update `FindESMF.cmake` to match that in ESMF 8.6.1
-
-### Changed
-
+- Add timer to the sampler code
 - Set required version of ESMF to 8.6.1
 - Update `components.yaml`
   - ESMA_cmake v3.45.0

base/MAPL_ObsUtil.F90

@@ -941,11 +941,16 @@ subroutine fglob(search_name, filename, rc)     ! give the last name
 
     character(kind=C_CHAR, len=:), allocatable :: c_search_name
     character(kind=C_CHAR, len=512) :: c_filename
-    integer slen
+    integer :: slen, lenmax
 
     c_search_name = trim(search_name)//C_NULL_CHAR
     rc = f_call_c_glob(c_search_name, c_filename, slen)
     filename=""
+    lenmax = len(filename)
+    if (lenmax < slen) then
+       if (MAPL_AM_I_ROOT())  write(6,*) 'pathlen vs filename_max_char_len: ', slen, lenmax
+       _FAIL ('PATHLEN is greater than filename_max_char_len')
+    end if
     if (slen>0) filename(1:slen)=c_filename(1:slen)
 
     return

gridcomps/History/MAPL_HistoryCollection.F90

@@ -9,7 +9,7 @@ module MAPL_HistoryCollectionMod
   use MAPL_VerticalDataMod
   use MAPL_TimeDataMod
   use HistoryTrajectoryMod
-  use MaskSamplerGeosatMod  
+  use MaskSamplerGeosatMod
   use StationSamplerMod
   use gFTL_StringStringMap
   use MAPL_EpochSwathMod

gridcomps/History/MAPL_HistoryGridComp.F90

@@ -2422,7 +2422,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc )
              list(n)%timeInfo = TimeData(clock,tm,MAPL_nsecf(list(n)%frequency),IntState%stampoffset(n),integer_time=intstate%integer_time)
           end if
           if (list(n)%timeseries_output) then
-             list(n)%trajectory = HistoryTrajectory(cfg,string,clock,_RC)
+             list(n)%trajectory = HistoryTrajectory(cfg,string,clock,genstate=GENSTATE,_RC)
              call list(n)%trajectory%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC)
              IntState%stampoffset(n) = list(n)%trajectory%epoch_frequency
           elseif (list(n)%sampler_spec == 'mask') then
@@ -3451,11 +3451,14 @@ subroutine Run ( gc, import, export, clock, rc )
   ! swath only
    epoch_swath_grid_case: do n=1,nlist
       call MAPL_TimerOn(GENSTATE,trim(list(n)%collection))
-      call MAPL_TimerOn(GENSTATE,"SwathGen")
       if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then
+         call MAPL_TimerOn(GENSTATE,"Swath")
+         call MAPL_TimerOn(GENSTATE,"RegridAccum")
          call Hsampler%regrid_accumulate(list(n)%xsampler,_RC)
+         call MAPL_TimerOff(GENSTATE,"RegridAccum")
 
          if( ESMF_AlarmIsRinging ( Hsampler%alarm ) ) then
+            call MAPL_TimerOn(GENSTATE,"RegenGriddedio")
             create_mode = PFIO_NOCLOBBER ! defaut no overwrite
             if (intState%allow_overwrite) create_mode = PFIO_CLOBBER
             ! add time to items
@@ -3473,12 +3476,13 @@ subroutine Run ( gc, import, export, clock, rc )
             call list(n)%mGriddedIO%destroy(_RC)
             call list(n)%mGriddedIO%CreateFileMetaData(list(n)%items,list(n)%xsampler%acc_bundle,timeinfo_uninit,vdata=list(n)%vdata,global_attributes=global_attributes,_RC)
             call list(n)%items%pop_back()
-
             collection_id = o_Clients%add_hist_collection(list(n)%mGriddedIO%metadata, mode = create_mode)
             call list(n)%mGriddedIO%set_param(write_collection_id=collection_id)
+            call MAPL_TimerOff(GENSTATE,"RegenGriddedio")
          endif
+         call MAPL_TimerOff(GENSTATE,"Swath")
       end if
-      call MAPL_TimerOff(GENSTATE,"SwathGen")
+
       call MAPL_TimerOff(GENSTATE,trim(list(n)%collection))
    end do epoch_swath_grid_case
 
@@ -3525,7 +3529,7 @@ subroutine Run ( gc, import, export, clock, rc )
                ! it's tempting to use the variable "oneMonth" but it does not work
                ! instead we compute the differece between
                ! thisMonth and lastMonth and as a new timeInterval
-
+               !
                call ESMF_ClockGet(clock,currTime=current_time,_RC)
                call ESMF_TimeIntervalSet( oneMonth, MM=1, _RC)
                lastMonth = current_time - oneMonth
@@ -3645,6 +3649,7 @@ subroutine Run ( gc, import, export, clock, rc )
          if (.not.list(n)%timeseries_output .AND. &
               list(n)%sampler_spec /= 'station' .AND. &
               list(n)%sampler_spec /= 'mask') then
+
             IOTYPE: if (list(n)%unit < 0) then    ! CFIO
                call list(n)%mGriddedIO%bundlepost(list(n)%currentFile,oClients=o_Clients,_RC)
             else
@@ -3691,14 +3696,24 @@ subroutine Run ( gc, import, export, clock, rc )
             end if IOTYPE
          end if
 
+
          if (list(n)%sampler_spec == 'station') then
             call ESMF_ClockGet(clock,currTime=current_time,_RC)
+            call MAPL_TimerOn(GENSTATE,"Station")
+            call MAPL_TimerOn(GENSTATE,"AppendFile")
             call list(n)%station_sampler%append_file(current_time,_RC)
+            call MAPL_TimerOff(GENSTATE,"AppendFile")
+            call MAPL_TimerOff(GENSTATE,"Station")
          elseif (list(n)%sampler_spec == 'mask') then
             call ESMF_ClockGet(clock,currTime=current_time,_RC)
+            call MAPL_TimerOn(GENSTATE,"Mask")
+            call MAPL_TimerOn(GENSTATE,"AppendFile")
             call list(n)%mask_sampler%append_file(current_time,_RC)
+            call MAPL_TimerOff(GENSTATE,"AppendFile")
+            call MAPL_TimerOff(GENSTATE,"Mask")
          endif
 
+
       endif OUTTIME
 
       if( NewSeg(n) .and. list(n)%unit /= 0 .and. list(n)%duration /= 0 ) then
@@ -3724,20 +3739,20 @@ subroutine Run ( gc, import, export, clock, rc )
   ! swath only
    epoch_swath_regen_grid: do n=1,nlist
       call MAPL_TimerOn(GENSTATE,trim(list(n)%collection))
-      call MAPL_TimerOn(GENSTATE,"Swath regen")
       if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then
+         call MAPL_TimerOn(GENSTATE,"Swath")
          if( ESMF_AlarmIsRinging ( Hsampler%alarm ) .and. .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then
-
+            call MAPL_TimerOn(GENSTATE,"RegenGrid")
             key_grid_label = list(n)%output_grid_label
             call Hsampler%destroy_rh_regen_ogrid ( key_grid_label, IntState%output_grids, list(n)%xsampler, _RC )
-
             pgrid => IntState%output_grids%at(trim(list(n)%output_grid_label))
             call list(n)%xsampler%Create_bundle_RH(list(n)%items,list(n)%bundle,Hsampler%tunit, &
                  ogrid=pgrid,vdata=list(n)%vdata,_RC)
             if( MAPL_AM_I_ROOT() )  write(6,'(//)')
+            call MAPL_TimerOff(GENSTATE,"RegenGrid")
          endif
+         call MAPL_TimerOff(GENSTATE,"Swath")
       end if
-      call MAPL_TimerOff(GENSTATE,"Swath regen")
       call MAPL_TimerOff(GENSTATE,trim(list(n)%collection))
    end do epoch_swath_regen_grid
 
@@ -3754,16 +3769,24 @@ subroutine Run ( gc, import, export, clock, rc )
    WRITELOOP: do n=1,nlist
 
       call MAPL_TimerOn(GENSTATE,trim(list(n)%collection))
-      call MAPL_TimerOn(GENSTATE,"Write Timeseries")
+
       if (list(n)%timeseries_output) then
+         call MAPL_TimerOn(GENSTATE,"Trajectory")
+         call MAPL_TimerOn(GENSTATE,"RegridAccum")
          call list(n)%trajectory%regrid_accumulate(_RC)
+         call MAPL_TimerOff(GENSTATE,"RegridAccum")
          if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then
+            call MAPL_TimerOn(GENSTATE,"AppendFile")
             call list(n)%trajectory%append_file(current_time,_RC)
             call list(n)%trajectory%close_file_handle(_RC)
+            call MAPL_TimerOff(GENSTATE,"AppendFile")
             if ( .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then
+               call MAPL_TimerOn(GENSTATE,"RegenLS")
                call list(n)%trajectory%destroy_rh_regen_LS (_RC)
+               call MAPL_TimerOff(GENSTATE,"RegenLS")
             end if
          end if
+         call MAPL_TimerOff(GENSTATE,"Trajectory")
       end if
 
       if( Writing(n) .and. list(n)%unit < 0) then
@@ -3772,7 +3795,6 @@ subroutine Run ( gc, import, export, clock, rc )
 
       end if
 
-      call MAPL_TimerOff(GENSTATE,"Write Timeseries")
       call MAPL_TimerOff(GENSTATE,trim(list(n)%collection))
    enddo WRITELOOP
 

gridcomps/History/Sampler/MAPL_TrajectoryMod.F90

@@ -7,6 +7,8 @@ module HistoryTrajectoryMod
   use LocStreamFactoryMod
   use MAPL_LocstreamRegridderMod
   use MAPL_ObsUtilMod
+  use MAPL_GenericMod, only : MAPL_MetaComp
+
   use, intrinsic :: iso_fortran_env, only: REAL64
   implicit none
 
@@ -26,6 +28,7 @@ module HistoryTrajectoryMod
      real(kind=REAL64), allocatable :: times_R8(:)
      integer,           allocatable :: obstype_id(:)
      integer,           allocatable :: location_index_ioda(:)   ! location index in its own ioda file
+     type(MAPL_MetaComp), pointer   :: GENSTATE
 
      type(ESMF_FieldBundle) :: bundle
      type(ESMF_FieldBundle) :: output_bundle
@@ -97,11 +100,12 @@ module HistoryTrajectoryMod
 
 
   interface
-     module function HistoryTrajectory_from_config(config,string,clock,rc) result(traj)
+     module function HistoryTrajectory_from_config(config,string,clock,GENSTATE,rc) result(traj)
        type(HistoryTrajectory) :: traj
        type(ESMF_Config), intent(inout)        :: config
        character(len=*),  intent(in)           :: string
        type(ESMF_Clock),  intent(in)           :: clock
+       type(MAPL_MetaComp), pointer, intent(in), optional  :: GENSTATE
        integer, optional, intent(out)          :: rc
      end function HistoryTrajectory_from_config
 

gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90

@@ -51,6 +51,7 @@
 
 
          traj%clock=clock
+         if (present(GENSTATE)) traj%GENSTATE => GENSTATE
          call ESMF_ClockGet ( clock, CurrTime=currTime, _RC )
          call ESMF_ConfigGetAttribute(config, value=time_integer, label=trim(string)//'Epoch:', default=0, _RC)
          _ASSERT(time_integer /= 0, 'Epoch value in config wrong')
@@ -1105,7 +1106,6 @@
                         if (nx>0) then
                            do ig = 1, this%obs(k)%ngeoval
                               if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then
-                                 call lgr%debug('%a %a', 'append:2d inner put_var item%xname', trim(item%xname))
                                  call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p2d(1:nx), &
                                       start=[is],count=[nx])
                               end if
@@ -1173,7 +1173,6 @@
                         if (nx>0) then
                            do ig = 1, this%obs(k)%ngeoval
                               if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then
-                                 call lgr%debug('%a %a', 'append:3d inner put_var item%xname', trim(item%xname))
                                  call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p3d(:,:), &
                                       start=[is,1],count=[nx,size(p_acc_rt_3d,2)])
                               end if

pfio/BaseThread.F90

@@ -29,6 +29,7 @@ module pFIO_BaseThreadMod
       procedure :: clear_RequestHandle
       procedure :: get_RequestHandle
       procedure :: insert_RequestHandle
+      procedure :: isEmpty_RequestHandle
    end type BaseThread
 
 contains
@@ -66,6 +67,17 @@ function get_RequestHandle(this,request_id, rc) result(rh_ptr)
       _RETURN(_SUCCESS)
    end function get_RequestHandle
 
+   function isEmpty_RequestHandle(this, rc) result(empty)
+      class (BaseThread), target, intent(in) :: this
+      integer, optional, intent(out) :: rc
+      logical :: empty
+      type (IntegerRequestMapIterator) :: iter
+
+      iter  = this%open_requests%begin()
+      empty = (iter == this%open_requests%end())
+      _RETURN(_SUCCESS)
+   end function isEmpty_RequestHandle
+
    subroutine insert_RequestHandle(this,request_id, handle, rc) 
       class (BaseThread), target, intent(inout) :: this
       integer, intent(in) :: request_id

pfio/ClientThread.F90

@@ -410,6 +410,10 @@ subroutine done_prefetch(this, rc)
       class(AbstractSocket),pointer :: connection
       integer :: status
 
+      if (this%isEmpty_RequestHandle()) then
+        _RETURN(_SUCCESS)
+      endif
+
       connection=>this%get_connection()
       call connection%send(PrefetchDoneMessage(),_RC)
       _RETURN(_SUCCESS)
@@ -420,6 +424,10 @@ subroutine done_collective_prefetch(this, rc)
       integer, optional, intent(out) :: rc
       class(AbstractSocket),pointer :: connection
       integer :: status
+
+      if (this%isEmpty_RequestHandle()) then
+        _RETURN(_SUCCESS)
+      endif
 
       connection=>this%get_connection()
       call connection%send(CollectivePrefetchDoneMessage(),_RC)
@@ -432,6 +440,10 @@ subroutine done_stage(this, rc)
       class(AbstractSocket),pointer :: connection
       integer :: status
 
+      if (this%isEmpty_RequestHandle()) then
+        _RETURN(_SUCCESS)
+      endif
+
       connection=>this%get_connection()
       call connection%send(StageDoneMessage(),_RC)
       _RETURN(_SUCCESS)
@@ -443,6 +455,10 @@ subroutine done_collective_stage(this, rc)
       class(AbstractSocket),pointer :: connection
       integer :: status
 
+      if (this%isEmpty_RequestHandle()) then
+        _RETURN(_SUCCESS)
+      endif
+
       connection=>this%get_connection()
       call connection%send(CollectiveStageDoneMessage(),_RC)
       _RETURN(_SUCCESS)