Merge pull request #735 from NCAR/mpi-win

remove copy of state into mpi window

Author: hkershaw-brown

.gitignore

@@ -203,6 +203,7 @@ test_quad_reg_interp
 test_table_read
 test_ran_unif
 test_kde_dist
+test_window
 
 # Directories to NOT IGNORE ... same as executable names
 # as far as I know, these must be listed after the executables

CHANGELOG.rst

@@ -22,17 +22,24 @@ individual files.
 
 The changes are now listed with the most recent at the top.
 
-**October 22 2024 :: Bug-fixes: WRF and GOES. Tag 11.8.2**
+**November 7 2024 :: MPI window memory reduction. Tag v11.8.3**
+
+- Removes unnecessary copy of state into mpi window.
+- Removes cray pointer version of the mpi window.
+- | Fortran-testanything included in developer tests. 
+  |  *From dennisdjensen: see developer_tests/contrib/fortran-testanything/LICENSE.txt*
+
+**October 22 2024 :: Bug-fixes: WRF and GOES. Tag v11.8.2**
 
 - Force THM to be the WRF-DART temperature variable
 - Remove offset on GOES observation converter 
 
-**September 27 2024 :: MOM6 mask bug-fix. Tag 11.8.1**
+**September 27 2024 :: MOM6 mask bug-fix. Tag v11.8.1**
 
 - Fix for MOM6 CESM3 workhorse 2/3 degree grid TL319_t232 to 
   mask missing geolon|lat|u|v|t values  
 
-**September 10 2024 :: MARBL_column. Tag 11.8.0**
+**September 10 2024 :: MARBL_column. Tag v11.8.0**
 
 - Interface for MARBL_column for DART: 
 
@@ -48,7 +55,7 @@ Bugfix:
 
 - fix for IO for NetCDF files when only some variables have the unlimited dimension  
 
-**August 29 2024 :: Bug fixes for shortest_time_between_assimilations and get_close_init. Tag 11.7.1**
+**August 29 2024 :: Bug fixes for shortest_time_between_assimilations and get_close_init. Tag v11.7.1**
 
 Bug fixes:
 
@@ -64,7 +71,7 @@ Doc fixes:
    - GitHub template for reporting documentation issues
 
 
-**August 26 2024 :: KQCEF. Tag 11.7.0**
+**August 26 2024 :: KQCEF. Tag v11.7.0**
 
 - Adds a Quantile-Conserving Ensemble Filter Based on Kernel-Density Estimation to DART.
 - New distribution module kde_distribution_mod.

assimilation_code/modules/utilities/cray_win_mod.f90

@@ -110,7 +110,7 @@ subroutine get_fwd(x, my_index, state_ens_handle)
       !x = get_local_state(element_index)
       x = state_ens_handle%copies(1:data_count, element_index)
    else
-     call get_from_fwd(owner_of_state, state_win, element_index, data_count, x)
+     call get_from_fwd(owner_of_state, state_win, element_index, state_ens_handle%num_copies, data_count, x)
    endif
 endif
 

assimilation_code/modules/utilities/distributed_state_mod.f90

@@ -1968,13 +1968,14 @@ end subroutine get_from_mean
 
 !-----------------------------------------------------------------------------
 
-subroutine get_from_fwd(owner, window, mindex, num_rows, x)
+subroutine get_from_fwd(owner, window, mindex, rows_in_window, num_rows, x)
 
 integer,  intent(in)  :: owner    ! task in the window that owns the memory
 integer,  intent(in)  :: window   ! window object
 integer,  intent(in)  :: mindex   ! index in the tasks memory
-integer,  intent(in)  :: num_rows ! number of rows in the window
-real(r8), intent(out) :: x(:)     ! result
+integer,  intent(in)  :: rows_in_window ! number of rows in the window
+integer,  intent(in)  :: num_rows ! number of rows to get from the window
+real(r8), intent(out) :: x(num_rows)     ! result
 
 integer(KIND=MPI_ADDRESS_KIND) :: target_disp
 integer :: errcode
@@ -1983,7 +1984,7 @@ subroutine get_from_fwd(owner, window, mindex, num_rows, x)
 ! to have occured until the call to mpi_win_unlock. 
 ! => Don't do anything with x in between mpi_get and mpi_win_lock
 
-target_disp = (mindex - 1)*num_rows
+target_disp = (mindex - 1)*rows_in_window
 call mpi_win_lock(MPI_LOCK_SHARED, owner, 0, window, errcode)
 call mpi_get(x, num_rows, datasize, owner, target_disp, num_rows, datasize, window, errcode)
 call mpi_win_unlock(owner, window, errcode)

assimilation_code/modules/utilities/mpi_utilities_mod.f90

@@ -1969,12 +1969,13 @@ end subroutine get_from_mean
 
 !-----------------------------------------------------------------------------
 
-subroutine get_from_fwd(owner, window, mindex, num_rows, x)
+subroutine get_from_fwd(owner, window, mindex, rows_in_window, num_rows, x)
 
 integer,  intent(in)  :: owner    ! task in the window that owns the memory
 type(MPI_Win),  intent(in)  :: window   ! window object
 integer,  intent(in)  :: mindex   ! index in the tasks memory
-integer,  intent(in)  :: num_rows ! number of rows in the window
+integer,  intent(in)  :: rows_in_window ! number of rows in the window
+integer,  intent(in)  :: num_rows ! number of rows to get from the window
 real(r8), intent(out) :: x(num_rows)     ! result
 
 integer(KIND=MPI_ADDRESS_KIND) :: target_disp
@@ -1984,7 +1985,7 @@ subroutine get_from_fwd(owner, window, mindex, num_rows, x)
 ! to have occured until the call to mpi_win_unlock. 
 ! => Don't do anything with x in between mpi_get and mpi_win_lock
 
-target_disp = (mindex - 1)*num_rows
+target_disp = (mindex - 1)*rows_in_window
 call mpi_win_lock(MPI_LOCK_SHARED, owner, 0, window, errcode)
 call mpi_get(x, num_rows, datasize, owner, target_disp, num_rows, datasize, window, errcode)
 call mpi_win_unlock(owner, window, errcode)

assimilation_code/modules/utilities/mpif08_utilities_mod.f90

@@ -634,13 +634,14 @@ end subroutine get_from_mean
 
 !-----------------------------------------------------------------------------
 
-subroutine get_from_fwd(owner, window, mindex, num_rows, x)
+subroutine get_from_fwd(owner, window, mindex, rows_in_window, num_rows, x)
 
 integer,  intent(in)  :: owner    ! task in the window that owns the memory
 integer,  intent(in)  :: window   ! window object
 integer,  intent(in)  :: mindex   ! index in the tasks memory
-integer,  intent(in)  :: num_rows ! number of rows in the window
-real(r8), intent(out) :: x(num_rows) ! result
+integer,  intent(in)  :: rows_in_window ! number of rows in the window
+integer,  intent(in)  :: num_rows ! number of rows to get from the window
+real(r8), intent(out) :: x(num_rows)     ! result
 
 call error_handler(E_ERR,'get_from_fwd', 'cannot be used in serial mode', source)