diff --git a/CHANGELOG.md b/CHANGELOG.md index f1def5cfd131..c5eb5be4b69d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,21 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.50.0] - 2024-10-10 + +### Added + +- Added `MAPL_Reverse_Schmidt` to reverse the stretched grid for indices computation + +### Changed + +- Propagated the error message from `MAPL_HorzIJIndex` subroutine +- Updated minimum CMake version to 3.23 + +### Fixed + +- Trapped more errors from Extdata's i-server + ## [2.49.1] - 2024-10-07 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 7db50cdad264..27e90cb1f936 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required (VERSION 3.17) +cmake_minimum_required (VERSION 3.23) get_property(is_multi_config GLOBAL PROPERTY GENERATOR_IS_MULTI_CONFIG) if(NOT is_multi_config AND NOT (CMAKE_BUILD_TYPE OR DEFINED ENV{CMAKE_BUILD_TYPE})) @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.49.1 + VERSION 2.50.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui diff --git a/base/Base/Base_Base.F90 b/base/Base/Base_Base.F90 index dcef19267c47..e5baa73393c5 100644 --- a/base/Base/Base_Base.F90 +++ b/base/Base/Base_Base.F90 @@ -61,6 +61,7 @@ module MAPL_Base public MAPL_FieldBundleDestroy public MAPL_GetHorzIJIndex public MAPL_GetGlobalHorzIJIndex + public MAPL_Reverse_Schmidt public MAPL_GenGridName public MAPL_GenXYOffset public MAPL_GeosNameNew @@ -712,6 +713,21 @@ module subroutine MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, integer, optional, intent(out ) :: rc ! return code end subroutine MAPL_GetGlobalHorzIJIndex + module subroutine MAPL_Reverse_Schmidt(Grid, stretched, npts,lon,lat,lonR8,latR8, lonRe, latRe, rc) + use ESMF, only: ESMF_KIND_R8, ESMF_GRid + implicit none + !ARGUMENTS: + type(ESMF_Grid), intent(inout) :: Grid ! ESMF grid + logical, intent(out ) :: stretched + integer, intent(in ) :: npts ! number of points in lat and lon arrays + real, optional, intent(in ) :: lon(npts) ! array of longitudes in radians + real, optional, intent(in ) :: lat(npts) ! array of latitudes in radians + real(ESMF_KIND_R8), optional, intent(in ) :: lonR8(npts) ! array of longitudes in radians + real(ESMF_KIND_R8), optional, intent(in ) :: latR8(npts) ! array of latitudes in radians + real(ESMF_KIND_R8), optional, intent(out ) :: lonRe(npts) ! array of longitudes in radians + real(ESMF_KIND_R8), optional, intent(out ) :: latRe(npts) ! array of latitudes in radians + integer, optional, intent(out ) :: rc ! return code + end subroutine MAPL_Reverse_Schmidt module subroutine MAPL_GenGridName(im, jm, lon, lat, xyoffset, gridname, geos_style) integer :: im, jm diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index a070bee5cba3..b50e84e98897 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -24,6 +24,8 @@ ! !USES: ! use ESMF + use ESMFL_Mod + use MAPL_FieldUtils use MAPL_Constants use MAPL_RangeMod @@ -132,7 +134,6 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & integer :: ub1, ub2, ub3 ! SSI - character(len=ESMF_MAXSTR) :: name type(ESMF_Pin_Flag) :: pinflag type(ESMF_VM) :: vm logical :: ssiSharedMemoryEnabled @@ -2595,8 +2596,8 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) real(ESMF_KIND_R8), allocatable :: elats(:) integer :: i,iiloc,jjloc, i1, i2, j1, j2 real(ESMF_KIND_R4) :: lonloc,latloc - logical :: localSearch - real(ESMF_KIND_R8), allocatable :: target_lons(:),target_lats(:) + logical :: localSearch + real(ESMF_KIND_R8), allocatable :: tmp_lons(:),tmp_lats(:) type(ESMF_CoordSys_Flag) :: coordSys character(len=ESMF_MAXSTR) :: grid_type @@ -2617,20 +2618,20 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) localSearch = .false. end if - allocate(target_lons(npts),target_lats(npts)) + allocate(tmp_lons(npts),tmp_lats(npts)) if (present(lon) .and. present(lat)) then - target_lons = lon - target_lats = lat + tmp_lons = lon + tmp_lats = lat else if (present(lonR8) .and. present(latR8)) then - target_lons = lonR8 - target_lats = latR8 + tmp_lons = lonR8 + tmp_lats = latR8 end if !AOO change tusing GridType atribute if (im_world*6==jm_world) then call ESMF_AttributeGet(grid, name='GridType', value=grid_type, _RC) if(trim(grid_type) == "Cubed-Sphere") then - call MAPL_GetGlobalHorzIJIndex(npts, II, JJ, lon=lon, lat=lat, lonR8=lonR8, latR8=latR8, Grid=Grid, rc=rc) + call MAPL_GetGlobalHorzIJIndex(npts, II, JJ, lon=lon, lat=lat, lonR8=lonR8, latR8=latR8, Grid=Grid, _RC) call MAPL_Grid_Interior(Grid,i1,i2,j1,j2) ! convert index to local, if it is not in domain, set it to -1 just as the legacy code @@ -2662,8 +2663,8 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) ! lat-lon grid goes from -180 to 180 shift if we must ! BMA this -180 to 180 might change at some point do i=1,npts - lonloc = target_lons(i) - latloc = target_lats(i) + lonloc = tmp_lons(i) + latloc = tmp_lats(i) if (lonloc > MAPL_PI) lonloc = lonloc - 2.0*MAPL_PI IIloc = ijsearch(elons,im+1,lonloc,.false.) JJloc = ijsearch(elats,jm+1,latloc,.false.) @@ -2673,7 +2674,7 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) deallocate(elons,elats) end if - deallocate(target_lons, target_lats) + deallocate(tmp_lons, tmp_lats) _RETURN(ESMF_SUCCESS) contains @@ -2745,7 +2746,7 @@ module subroutine MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, real(ESMF_KIND_R8), allocatable, dimension (:,:) :: xyz real(ESMF_KIND_R8), allocatable, dimension (:) :: x,y,z real(ESMF_KIND_R8), allocatable :: max_abs(:) - real(ESMF_KIND_R8) :: dalpha + real(ESMF_KIND_R8) :: dalpha, shift0 real(ESMF_KIND_R8), allocatable :: lons(:), lats(:) ! sqrt(2.0d0), distance from center to the mid of an edge for a 2x2x2 cube @@ -2757,7 +2758,10 @@ module subroutine MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, ! MAPL_PI_R8/18, Japan Fuji mountain shift real(ESMF_KIND_R8), parameter :: shift= 0.174532925199433d0 - logical :: good_grid + logical :: good_grid, stretched + + ! Return if no local points + _RETURN_IF(npts == 0) if ( .not. present(grid)) then _FAIL("need a cubed-sphere grid") @@ -2767,23 +2771,23 @@ module subroutine MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, JM_World = dims(2) _ASSERT( IM_WORLD*6 == JM_WORLD, "It only works for cubed-sphere grid") + allocate(lons(npts),lats(npts)) + + call MAPL_Reverse_Schmidt(Grid, stretched, npts, lon=lon, lat=lat, lonR8=lonR8, latR8=latR8, lonRe=lons, latRe=lats, _RC) + dalpha = 2.0d0*alpha/IM_WORLD ! make sure the grid can be used in this subroutine good_grid = grid_is_ok(grid) - _ASSERT( good_grid, "MAPL_GetGlobalHorzIJIndex cannot handle this grid") - allocate(lons(npts),lats(npts)) - if (present(lon) .and. present(lat)) then - lons = lon - lats = lat - else if (present(lonR8) .and. present(latR8)) then - lons = lonR8 - lats = latR8 - end if + if ( .not. good_grid ) then + _FAIL( "MAPL_GetGlobalHorzIJIndex cannot handle this grid") + endif ! shift the grid away from Japan Fuji Mt. - lons = lons + shift + shift0 = shift + if (stretched) shift0 = 0 + lons = lons + shift0 ! get xyz from sphere surface allocate(xyz(3, npts), max_abs(npts)) @@ -2805,9 +2809,6 @@ module subroutine MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, II = -1 JJ = -1 - ! Return if no local points - _RETURN_IF(npts == 0) - ! The edge points are assigned in the order of face 1,2,3,4,5,6 call calculate(x,y,z,II,JJ) @@ -2868,7 +2869,9 @@ function grid_is_ok(grid) result(OK) logical :: OK integer :: I1, I2, J1, J2, j real(ESMF_KIND_R8), pointer :: corner_lons(:,:), corner_lats(:,:) - real(ESMF_KIND_R8) :: accurate_lat, accurate_lon + real(ESMF_KIND_R8), allocatable :: lonRe(:), latRe(:) + real(ESMF_KIND_R8), allocatable :: accurate_lat(:), accurate_lon(:) + real(ESMF_KIND_R8) :: stretch_factor, target_lon, target_lat, shift0 real :: tolerance tolerance = epsilon(1.0) @@ -2880,33 +2883,30 @@ function grid_is_ok(grid) result(OK) call ESMF_GridGetCoord(grid,localDE=0,coordDim=2,staggerloc=ESMF_STAGGERLOC_CORNER, & farrayPtr=corner_lats, rc=status) - if ( I1 ==1 .and. J2<=IM_WORLD ) then - if (J1 == 1) then - accurate_lon = 1.750d0*MAPL_PI_R8 - shift - if (abs(accurate_lon - corner_lons(1,1)) > tolerance) then - print*, "accurate_lon: ", accurate_lon - print*, "corner_lon : ", corner_lons(1,1) - print*, "Error: Grid should have pi/18 shift" - OK = .false. - return - endif - endif - do j = J1+1, J2 - accurate_lat = -alpha + (j-1)*dalpha - if ( abs(accurate_lat - corner_lats(1,j-J1+1)) > 5.0*tolerance) then - print*, "accurate_lat: ", accurate_lat - print*, "edge_lat : ", corner_lats(1,j-J1+1) - print*, "edge point : ", j - print*, "Error: It could be " - print*, " 1)Grid is NOT gnomonic_ed;" - print*, " 2)lats lons from MAPL_GridGetCorners are NOT accurate (single precision from ESMF)" - print*, " 3)This is a stretched grid which is not yet supported" - OK = .false. - return - endif - enddo - endif + if ( I1 == 1 .and. J1 == 1 ) then + allocate(lonRe(j2-j1+1), latRe(j2-j1+1)) + call MAPL_Reverse_Schmidt(grid, stretched, J2-J1+1, lonR8=corner_lons(1,:), & + latR8=corner_lats(1,:), lonRe=lonRe, latRe=latRe, _RC) + + allocate(accurate_lon(j2-j1+1), accurate_lat(j2-j1+1)) + + shift0 = shift + if (stretched) shift0 = 0 + + accurate_lon = 1.750d0*MAPL_PI_R8 - shift0 + accurate_lat = [(-alpha + (j-1)*dalpha, j = j1, j2)] + + if (any(abs(accurate_lon - lonRe) > 2.0* tolerance) .or. any(abs(accurate_lat - latRe) > 2.0*tolerance)) then + print*, "Error: It could be " + print*, " 1) grid may not have pi/18 Japan mountain shift" + print*, " 2) grid is NOT gnomonic_ed;" + print*, " 3) lats lons from MAPL_GridGetCorners are NOT accurate (single precision from ESMF)" + print*, " 4) strtech grid rotates north pole" + OK = .false. + return + endif + endif end function end subroutine MAPL_GetGlobalHorzIJIndex @@ -3203,7 +3203,7 @@ module subroutine MAPL_FieldSplit(field, fields, aliasName, rc) ! local vars integer :: status integer :: k, n - integer :: k1,k2,kk + integer :: k1,k2 logical :: has_ungrd integer :: ungrd_cnt integer :: fieldRank @@ -3381,4 +3381,96 @@ module function MAPL_GetCorrectedPhase(gc,rc) result(phase) _RETURN(_SUCCESS) end function MAPL_GetCorrectedPhase + module subroutine MAPL_Reverse_Schmidt(Grid, stretched, npts, lon, lat, lonR8, latR8, lonRe, latRe, rc) + type(ESMF_Grid), intent(inout) :: Grid + logical, intent(out) :: stretched + integer, intent(in ) :: npts ! number of points in lat and lon arrays + real, optional, intent(in ) :: lon(npts) ! array of longitudes in radians + real, optional, intent(in ) :: lat(npts) ! array of latitudes in radians + real(ESMF_KIND_R8), optional, intent(in ) :: lonR8(npts) ! array of longitudes in radians + real(ESMF_KIND_R8), optional, intent(in ) :: latR8(npts) ! + real(ESMF_KIND_R8), optional, intent(out ) :: lonRe(npts) ! + real(ESMF_KIND_R8), optional, intent(out ) :: latRe(npts) ! + integer, optional, intent(out) :: rc + + logical :: factorPresent, lonPresent, latPresent + integer :: status + real(ESMF_KIND_R8) :: c2p1, c2m1, half_pi, two_pi, stretch_factor, target_lon, target_lat + real(ESMF_KIND_R8), dimension(npts) :: x,y,z, Xx, Yy, Zz + logical, dimension(npts) :: n_s + + _RETURN_IF( npts == 0 ) + + call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', isPresent= factorPresent, _RC) + call ESMF_AttributeGet(grid, name='TARGET_LON', isPresent= lonPresent, _RC) + call ESMF_AttributeGet(grid, name='TARGET_LAT', isPresent= latPresent, _RC) + + if ( factorPresent .and. lonPresent .and. latPresent) then + stretched = .true. + else + stretched = .false. + endif + + if (present(lonRe) .and. present(latRe)) then + if (present(lonR8) .and. present(latR8)) then + lonRe = lonR8 + latRe = latR8 + else if (present(lon) .and. present(lat)) then + lonRe = lon + latRe = lat + else + _FAIL("Need input to get the output lonRe, latRe") + endif + else + _RETURN(_SUCCESS) + endif + + if (.not. stretched) then + _RETURN(_SUCCESS) + endif + + call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', value=stretch_factor, _RC) + call ESMF_AttributeGet(grid, name='TARGET_LON', value=target_lon, _RC) + call ESMF_AttributeGet(grid, name='TARGET_LAT', value=target_lat, _RC) + + c2p1 = 1 + stretch_factor*stretch_factor + c2m1 = 1 - stretch_factor*stretch_factor + + half_pi = MAPL_PI_R8/2 + two_pi = MAPL_PI_R8*2 + + target_lon = target_lon*MAPL_DEGREES_TO_RADIANS_R8 + target_lat = target_lat*MAPL_DEGREES_TO_RADIANS_R8 + + x = cos(latRe)*cos(lonRe - target_lon) + y = cos(latRe)*sin(lonRe - target_lon) + z = sin(latRe) + + Xx = sin(target_lat)*x - cos(target_lat)*z + Yy = -y + Zz = -cos(target_lat)*x - sin(target_lat)*z + + n_s = (1. - abs(Zz)) < 10**(-7) + + where(n_s) + lonRe = 0.0d0 + latRe = half_pi*sign(1.0d0, Zz) + elsewhere + lonRe = atan2(Yy,Xx) + latRe = asin(Zz) + endwhere + + if (abs(c2m1) > 10**(-7)) then !# unstretch + latRe = asin( (c2m1-c2p1*sin(latRe))/(c2m1*sin(latRe)-c2p1)) + endif + + where ( lonRe < 0) + lonRe = lonRe + two_pi + elsewhere (lonRe >= two_pi) + lonRe = lonRe - two_pi + endwhere + + _RETURN(_SUCCESS) + end subroutine + end submodule Base_Implementation diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 63b3ac6ed89c..a52d116d2a34 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -1470,8 +1470,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 2561c0dd855a..d7f2ed39f490 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -601,8 +601,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 fba7adb6c341..6f0bd2b09c65 100644 --- a/griddedio/FieldBundleRead.F90 +++ b/griddedio/FieldBundleRead.F90 @@ -232,8 +232,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 06ec0754460e..e37b11191cde 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -1262,7 +1262,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 cbafb8473bd4..38f1d83b85cf 100644 --- a/pfio/ClientManager.F90 +++ b/pfio/ClientManager.F90 @@ -342,11 +342,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) @@ -356,11 +356,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) @@ -370,11 +371,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) @@ -384,11 +385,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) @@ -413,11 +414,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) @@ -428,10 +429,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) @@ -442,12 +444,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 @@ -491,6 +494,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() @@ -499,7 +503,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 @@ -552,7 +556,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 146c0f9b4745..a8d7cad8e95c 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -464,32 +464,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 08a3af2d9b41..c950fb2663f1 100644 --- a/pfio/FastClientThread.F90 +++ b/pfio/FastClientThread.F90 @@ -182,9 +182,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 02cd5f5da63b..bf2d61cd52bf 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -1030,7 +1030,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) @@ -1069,7 +1069,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 0e4f3a1b50ab..8106c11a2b69 100644 --- a/pfio/tests/MockClientThread.F90 +++ b/pfio/tests/MockClientThread.F90 @@ -53,17 +53,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