[Dart-dev] DART/branches Revision: 12589

[dart at ucar.edu]

hendric at ucar.edu
2018-05-18 10:53:29 -0600 (Fri, 18 May 2018)
139

adding an MPI_Reduce to send to sum of variables across
tasks to a single task.  Everything seems to be working
for absolute difference.




Modified: DART/branches/rma_closest_member_tool/assimilation_code/modules/utilities/mpi_utilities_mod.f90
===================================================================
--- DART/branches/rma_closest_member_tool/assimilation_code/modules/utilities/mpi_utilities_mod.f90	2018-05-17 22:33:06 UTC (rev 12588)
+++ DART/branches/rma_closest_member_tool/assimilation_code/modules/utilities/mpi_utilities_mod.f90	2018-05-18 16:53:29 UTC (rev 12589)
@@ -89,7 +89,6 @@
    module procedure sum_across_tasks_int4
    module procedure sum_across_tasks_int8
    module procedure sum_across_tasks_real
-   module procedure sum_across_tasks_real_array
 end interface
 
 !   ---- private data for mpi_utilities ----
@@ -108,7 +107,7 @@
           broadcast_send, broadcast_recv, shell_execute, sleep_seconds,      &
           sum_across_tasks, get_dart_mpi_comm, datasize, send_minmax_to,     &
           get_from_fwd, get_from_mean, broadcast_minmax, broadcast_flag,     &
-          start_mpi_timer, read_mpi_timer, &
+          start_mpi_timer, read_mpi_timer, send_sum_to,                      &
           all_reduce_min_max  ! deprecated, replace by broadcast_minmax
 
 ! version controlled file description for error handling, do not edit
@@ -1494,38 +1493,6 @@
 end subroutine sum_across_tasks_real
 
 !-----------------------------------------------------------------------------
-subroutine sum_across_tasks_real_array(addend, sum)
- real(r8), intent(in) :: addend(:)
- real(r8), intent(out) :: sum(:)
-
- integer :: errcode
- real(r8), allocatable :: localaddend(:), localsum(:)
-
-! cover routine for MPI all-reduce
-
-if ( .not. module_initialized ) then
-   write(errstring, *) 'initialize_mpi_utilities() must be called first'
-   call error_handler(E_ERR,'sum_across_tasks', errstring, source, revision, revdate)
-endif
-
-allocate(localaddend(size(addend)), localsum(size(addend)))
-localaddend(:) = addend(:)
-
-if (.true.) write(*,*) "PE", myrank, ": Allreduce called"
-
-call MPI_Allreduce(localaddend, localsum, 1, datasize, MPI_SUM, &
-                   0,my_local_comm, errcode)
-if (errcode /= MPI_SUCCESS) then
-   write(errstring, '(a,i8)') 'MPI_Allreduce returned error code ', errcode
-   call error_handler(E_ERR,'sum_across_tasks', errstring, source, revision, revdate)
-endif
-
-sum = localsum
-
-end subroutine sum_across_tasks_real_array
-
-
-!-----------------------------------------------------------------------------
 ! pipe-related utilities
 !-----------------------------------------------------------------------------
 
@@ -1918,6 +1885,27 @@
 !-----------------------------------------------------------------------------
 !-----------------------------------------------------------------------------
 ! Collect min and max on task.
+subroutine send_sum_to(local_val, task, global_val)
+
+real(r8), intent(in)  :: local_val(:) !> min max on each task
+integer,  intent(in)  :: task !> task to collect on
+real(r8), intent(out) :: global_val(:) !> only concerned with this on task collecting result
+
+integer :: errcode
+
+if ( .not. module_initialized ) then
+   write(errstring, *) 'initialize_mpi_utilities() must be called first'
+   call error_handler(E_ERR,'send_sum_to', errstring, source, revision, revdate)
+endif
+
+! collect values on a single given task 
+call mpi_reduce(local_val(:), global_val(:), size(global_val), datasize, MPI_SUM, task, get_dart_mpi_comm(), errcode)
+
+end subroutine send_sum_to
+
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+! Collect min and max on task.
 subroutine send_minmax_to(minmax, task, global_val)
 
 real(r8), intent(in)  :: minmax(2) !> min max on each task

Modified: DART/branches/rma_closest_member_tool/assimilation_code/programs/closest_member_tool/closest_member_tool.f90
===================================================================
--- DART/branches/rma_closest_member_tool/assimilation_code/programs/closest_member_tool/closest_member_tool.f90	2018-05-17 22:33:06 UTC (rev 12588)
+++ DART/branches/rma_closest_member_tool/assimilation_code/programs/closest_member_tool/closest_member_tool.f90	2018-05-18 16:53:29 UTC (rev 12589)
@@ -49,7 +49,7 @@
 
 use mpi_utilities_mod,    only : initialize_mpi_utilities, task_count,     &
                                  finalize_mpi_utilities, my_task_id, &
-                                 sum_across_tasks
+                                 send_sum_to
 
 use ensemble_manager_mod, only : ensemble_type, init_ensemble_manager, compute_copy_mean, &