Merge branch 'main' into all_reduce

.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/assimilation/normal_distribution_mod.f90

@@ -493,51 +493,6 @@ subroutine set_normal_params_from_ens(ens, num, p)
 
 end subroutine set_normal_params_from_ens
 
-!------------------------------------------------------------------------
-subroutine inv_cdf_quadrature_like(quantiles, ens, likelihood, ens_size, cdf, p, x_out) 
-
-interface
-   function cdf(x, p)
-      use types_mod, only : r8
-      use distribution_params_mod, only : distribution_params_type
-      real(r8)                                   :: cdf
-      real(r8), intent(in)                       :: x
-      type(distribution_params_type), intent(in) :: p
-   end function
-end interface
-
-integer,                        intent(in)  :: ens_size
-real(r8),                       intent(in)  :: quantiles(ens_size)
-real(r8),                       intent(in)  :: ens(ens_size)
-real(r8),                       intent(in)  :: likelihood(ens_size)
-type(distribution_params_type), intent(in)  :: p
-real(r8),                       intent(out) :: x_out(ens_size)
-
-integer :: i
-real(r8) :: quad_like(ens_size + 1), q_ens(ens_size + 1)
-
-! Assume that the quantiles and the corresponding ens are sorted
-
-! Get the likelihood for each of the ens_size + 1 intervals
-do i = 2, ens_size
-   quad_like(i) = (likelihood(i - 1) + likelihood(i)) / 2.0_r8
-end do
-quad_like(1) = likelihood(1)
-quad_like(ens_size + 1) = likelihood(ens_size)
-
-!  Compute the quantiles at the ensemble boundaries for the posterior
-q_ens(1) = quad_like(1) * quantiles(1)
-do i = 2, ens_size
-   q_ens(i) = q_ens(i - 1) + quad_like(i) * (quantiles(i) - quantiles(i - 1))
-end do
-q_ens(ens_size + 1) = q_ens(ens_size) + &
-   quad_like(ens_size + 1) * (1.0_r8 - quantiles(ens_size))
-
-! Normalize so that this is a posterior cdf
-q_ens = q_ens / q_ens(ens_size + 1)
-
-end subroutine inv_cdf_quadrature_like
-
 !------------------------------------------------------------------------
 
 end module normal_distribution_mod

assimilation_code/modules/utilities/distributed_state_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/mpi_utilities_mod.f90

@@ -1947,13 +1947,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
@@ -1962,7 +1963,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

@@ -1948,12 +1948,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
@@ -1963,7 +1964,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)