diff --git a/CHANGELOG.md b/CHANGELOG.md index 55999bc8d435..502adf50bfcf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -72,6 +72,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Trapped more errors from Extdata's i-server + ### Removed ### Deprecated diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 6e53e5e574e7..b1f07ab13e2a 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -1475,8 +1475,8 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"---IclientDone") - call i_Clients%done_collective_prefetch() - call i_Clients%wait() + call i_Clients%done_collective_prefetch(_RC) + call i_Clients%wait(_RC) call MAPL_TimerOff(MAPLSTATE,"---IclientDone") _VERIFY(STATUS) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index c2a40f14c5c3..b04c5de3e3a3 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -603,8 +603,8 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"---prefetch") call MAPL_TimerOn(MAPLSTATE,"---IclientDone") - call i_Clients%done_collective_prefetch() - call i_Clients%wait() + call i_Clients%done_collective_prefetch(_RC) + call i_Clients%wait(_RC) call MAPL_TimerOff(MAPLSTATE,"---IclientDone") diff --git a/griddedio/FieldBundleRead.F90 b/griddedio/FieldBundleRead.F90 index 5ab68204a270..9a4edf9b12a6 100644 --- a/griddedio/FieldBundleRead.F90 +++ b/griddedio/FieldBundleRead.F90 @@ -237,8 +237,8 @@ subroutine MAPL_read_bundle(bundle,file_tmpl,time,only_vars,regrid_method,noread end if call cfio%request_data_from_file(trim(file_name),timeindex=time_index,rc=status) _VERIFY(status) - call i_clients%done_collective_prefetch() - call i_clients%wait() + call i_clients%done_collective_prefetch(_RC) + call i_clients%wait(_RC) call cfio%process_data_from_file(rc=status) _VERIFY(status) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 61dc068221e7..aa47ec9f6a8e 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -1247,7 +1247,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) end if call i_Clients%collective_prefetch_data( & this%read_collection_id, fileName, trim(names(i)), & - & ref, start=localStart, global_start=globalStart, global_count=globalCount) + & ref, start=localStart, global_start=globalStart, global_count=globalCount, _RC) deallocate(localStart,globalStart,globalCount) enddo deallocate(gridLocalStart,gridGlobalStart,gridGlobalCount) diff --git a/griddedio/TileIO.F90 b/griddedio/TileIO.F90 index 88a5a518c1d5..faf1f52269d9 100644 --- a/griddedio/TileIO.F90 +++ b/griddedio/TileIO.F90 @@ -77,7 +77,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) end if ref = ArrayReference(this%tile_buffer(i)%ptr) call i_clients%collective_prefetch_data(this%read_collection_id, filename, trim(names(i)), ref, & - start=local_start, global_start=global_start, global_count = global_count) + start=local_start, global_start=global_start, global_count = global_count, _RC) deallocate(local_start,global_start,global_count) else _FAIL("rank >1 tile fields not supported") diff --git a/pfio/AbstractServer.F90 b/pfio/AbstractServer.F90 index 41185b46d47b..d93911f302b8 100644 --- a/pfio/AbstractServer.F90 +++ b/pfio/AbstractServer.F90 @@ -86,9 +86,10 @@ subroutine start(this, rc) integer, optional, intent(out) :: rc end subroutine start - subroutine clear_RequestHandle(this) + subroutine clear_RequestHandle(this, rc) import AbstractServer class(AbstractServer),target,intent(inout) :: this + integer, optional, intent(out) :: rc end subroutine clear_RequestHandle subroutine set_collective_request(this, request, have_done) @@ -224,7 +225,7 @@ subroutine update_status(this, rc) ! status ==0, means the last server thread in the backlog call this%clear_DataReference() - call this%clear_RequestHandle() + call this%clear_RequestHandle(_RC) call this%set_status(UNALLOCATED) call this%set_AllBacklogIsEmpty(.true.) @@ -248,11 +249,12 @@ subroutine clean_up(this, rc) class(AbstractServer), target, intent(inout) :: this integer, optional, intent(out) :: rc type(StringInteger64MapIterator) :: iter + integer :: status if (associated(ioserver_profiler)) call ioserver_profiler%start("clean_up") call this%clear_DataReference() - call this%clear_RequestHandle() + Call this%clear_RequestHandle(_RC) call this%set_AllBacklogIsEmpty(.true.) this%serverthread_done_msgs(:) = .false. diff --git a/pfio/BaseServer.F90 b/pfio/BaseServer.F90 index ced75e6517e5..479ffb8ce319 100644 --- a/pfio/BaseServer.F90 +++ b/pfio/BaseServer.F90 @@ -224,19 +224,19 @@ function get_dmessage(this, rc) result(dmessage) _RETURN(_SUCCESS) end function - subroutine clear_RequestHandle(this) + subroutine clear_RequestHandle(this, rc) class (BaseServer), target, intent(inout) :: this + integer, optional, intent(out):: rc class(ServerThread), pointer :: thread_ptr - integer :: i,n - + integer :: i,n, status n = this%threads%size() do i = 1, n thread_ptr => this%threads%at(i) - call thread_ptr%clear_RequestHandle() + call thread_ptr%clear_RequestHandle(_RC) enddo - + _RETURN(_SUCCESS) end subroutine clear_RequestHandle diff --git a/pfio/ClientManager.F90 b/pfio/ClientManager.F90 index 1d98922eb40b..9d9f67ee6f84 100644 --- a/pfio/ClientManager.F90 +++ b/pfio/ClientManager.F90 @@ -343,11 +343,11 @@ subroutine shake_hand(this, unusable, rc) class (ClientManager), intent(inout) :: this class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc - + integer :: status class (ClientThread), pointer :: clientPtr clientPtr =>this%current() - call clientPtr%shake_hand() + call clientPtr%shake_hand(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -357,11 +357,12 @@ subroutine done_prefetch(this, unusable, rc) class (ClientManager), intent(inout) :: this class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc + integer :: status class (ClientThread), pointer :: clientPtr clientPtr =>this%current() - call clientPtr%done_prefetch() + call clientPtr%done_prefetch(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -371,11 +372,11 @@ subroutine done_collective_prefetch(this, unusable, rc) class (ClientManager), intent(inout) :: this class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc - + integer :: status class (ClientThread), pointer :: clientPtr clientPtr =>this%current() - call clientPtr%done_collective_prefetch() + call clientPtr%done_collective_prefetch(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -385,11 +386,11 @@ subroutine done_stage(this, unusable, rc) class (ClientManager), intent(inout) :: this class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc - + integer :: status class (ClientThread), pointer :: clientPtr clientPtr =>this%current() - call clientPtr%done_stage() + call clientPtr%done_stage(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -414,11 +415,11 @@ subroutine wait(this, unusable, rc) class (ClientManager), target, intent(inout) :: this class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc - + integer :: status class (ClientThread), pointer :: clientPtr clientPtr =>this%current() - call clientPtr%wait_all() + call clientPtr%wait_all(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -429,10 +430,11 @@ subroutine post_wait(this, unusable, rc) class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc + integer :: status class (ClientThread), pointer :: clientPtr clientPtr =>this%current() - call clientPtr%post_wait_all() + call clientPtr%post_wait_all(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -443,12 +445,13 @@ subroutine terminate(this, unusable, rc) class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc + integer :: status class (ClientThread), pointer :: clientPtr integer :: i do i = 1, this%size() clientPtr =>this%clients%at(i) - call clientPtr%wait_all() + call clientPtr%wait_all(_RC) call clientPtr%terminate() enddo @@ -492,6 +495,7 @@ subroutine set_optimal_server(this,nwriting,unusable,rc) integer :: Cuttoff, ssize, lsize, tsize, ith integer, allocatable :: nwritings_order(:) real :: l_ratio, s_ratio + integer :: status ! if there is no "small" pool, then there is no "large" pool either, just get next ssize = this%small_server_pool%size() @@ -500,7 +504,7 @@ subroutine set_optimal_server(this,nwriting,unusable,rc) if (ssize == 0) then call this%next() - call this%wait() + call this%wait(_RC) _RETURN(_SUCCESS) endif @@ -553,7 +557,7 @@ subroutine set_optimal_server(this,nwriting,unusable,rc) nwritings_small(1:ssize-1) = nwritings_small(2:ssize) nwritings_small(ssize) = nwriting end if - call this%wait() + call this%wait(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) diff --git a/pfio/ClientThread.F90 b/pfio/ClientThread.F90 index 91e85c4438f4..73c542a199bc 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -461,32 +461,40 @@ subroutine done_collective_stage(this, rc) _RETURN(_SUCCESS) end subroutine done_collective_stage - subroutine wait(this, request_id) + subroutine wait(this, request_id, rc) use pFIO_AbstractRequestHandleMod class (ClientThread), target, intent(inout) :: this integer, intent(in) :: request_id + integer, optional, intent(out) :: rc + integer :: status class(AbstractRequestHandle), pointer :: handle handle => this%get_RequestHandle(request_id) call handle%wait() call handle%data_reference%deallocate() call this%erase_RequestHandle(request_id) - + _RETURN(_SUCCESS) + end subroutine wait - subroutine wait_all(this) + subroutine wait_all(this, rc) use pFIO_AbstractRequestHandleMod class (ClientThread), target, intent(inout) :: this - - call this%clear_RequestHandle() + integer, optional, intent(out) :: rc + integer:: status + call this%clear_RequestHandle(_RC) !call this%shake_hand() + _RETURN(_SUCCESS) end subroutine wait_all - subroutine post_wait_all(this) + subroutine post_wait_all(this, rc) use pFIO_AbstractRequestHandleMod class (ClientThread), target, intent(inout) :: this - call this%wait_all() + integer, optional, intent(out):: rc + integer :: status + call this%wait_all(_RC) + _RETURN(_SUCCESS) end subroutine post_wait_all integer function get_unique_request_id(this) result(request_id) diff --git a/pfio/FastClientThread.F90 b/pfio/FastClientThread.F90 index c67782f6ff6a..11573a52ac0c 100644 --- a/pfio/FastClientThread.F90 +++ b/pfio/FastClientThread.F90 @@ -181,9 +181,10 @@ function stage_nondistributed_data(this, collection_id, file_name, var_name, dat end function stage_nondistributed_data ! The data has been copied out and post no wait after isend - subroutine post_wait_all(this) + subroutine post_wait_all(this, rc) use pFIO_AbstractRequestHandleMod class (FastClientThread), target, intent(inout) :: this + integer, optional, intent(out) :: rc ! do nothing on purpose _UNUSED_DUMMY(this) end subroutine post_wait_all diff --git a/pfio/MultiCommServer.F90 b/pfio/MultiCommServer.F90 index c4a56b80d2f1..add4e0e4ffa2 100644 --- a/pfio/MultiCommServer.F90 +++ b/pfio/MultiCommServer.F90 @@ -471,7 +471,7 @@ subroutine clean_up(this, rc) call this%clear_DataReference() - call this%clear_RequestHandle() + call this%clear_RequestHandle(_RC) call this%set_AllBacklogIsEmpty(.true.) this%serverthread_done_msgs(:) = .false. diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index 0268f5c00ca9..4ca61b94daa5 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -273,6 +273,7 @@ subroutine clean_up(this, rc) class(MultiGroupServer), target, intent(inout) :: this integer, optional, intent(out) :: rc integer :: num_clients, n + integer :: status class (ServerThread),pointer :: thread_ptr if (this%front_Comm == MPI_COMM_NULL) then @@ -289,7 +290,7 @@ subroutine clean_up(this, rc) call thread_ptr%clear_hist_collections() enddo ! threads - call this%clear_RequestHandle() + call this%clear_RequestHandle(_RC) call this%set_AllBacklogIsEmpty(.true.) this%serverthread_done_msgs(:) = .false. diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index b29129d7dae7..40a0c41f44b7 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -1029,7 +1029,7 @@ recursive subroutine handle_Done_stage(this, message, rc) iter = this%request_backlog%begin() enddo - call this%clear_RequestHandle() + call this%clear_RequestHandle(_RC) call this%clear_hist_collections() _RETURN(_SUCCESS) @@ -1068,7 +1068,7 @@ recursive subroutine handle_Done_prefetch(this, message, rc) iter = this%request_backlog%begin() enddo - call this%clear_RequestHandle() + call this%clear_RequestHandle(_RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(message) diff --git a/pfio/tests/MockClientThread.F90 b/pfio/tests/MockClientThread.F90 index 827ed61b36c1..1b32ed0e2edc 100644 --- a/pfio/tests/MockClientThread.F90 +++ b/pfio/tests/MockClientThread.F90 @@ -54,17 +54,18 @@ function new_MockClientThread(sckt) result(c) if(present(sckt)) call c%set_connection(sckt) end function new_MockClientThread - subroutine wait(this, request_id) + subroutine wait(this, request_id, rc) use pFIO_AbstractRequestHandleMod class (MockClientThread), target, intent(inout) :: this integer, intent(in) :: request_id + integer, optional, intent(out) :: rc class(AbstractRequestHandle), pointer :: handle this%counter = this%counter + 1 handle => this%get_RequestHandle(request_id) call handle%wait() call this%erase_RequestHandle(request_id) - + _RETURN(_SUCCESS) end subroutine wait end module pFIO_MockClientThreadMod