[Dart-dev] DART/branches Revision: 12830

[dart at ucar.edu]

nancy at ucar.edu
2018-09-18 08:07:08 -0600 (Tue, 18 Sep 2018)
408
add send_sum_to() to both versions of the mpi utils;
include interface blocks (commented out) that allowed
me to build this with the NAG compiler.  we don't have
any NAG users that i know of, but the big win with
building with NAG is that it flags unused 'use' routines
so they can be removed.  none of our other compilers
seem to be able to determine which routines in the use lines
aren't in fact needed.




Modified: DART/branches/recam/assimilation_code/modules/utilities/mpi_utilities_mod.f90
===================================================================
--- DART/branches/recam/assimilation_code/modules/utilities/mpi_utilities_mod.f90	2018-09-18 14:01:17 UTC (rev 12829)
+++ DART/branches/recam/assimilation_code/modules/utilities/mpi_utilities_mod.f90	2018-09-18 14:07:08 UTC (rev 12830)
@@ -42,6 +42,19 @@
 
 ! !!NAG_BLOCK_EDIT START COMMENTED_OUT
 ! use F90_unix_proc, only : sleep, system, exit
+ !! block for NAG compiler
+ !  PURE SUBROUTINE SLEEP(SECONDS,SECLEFT)
+ !    INTEGER,INTENT(IN) :: SECONDS
+ !    INTEGER,OPTIONAL,INTENT(OUT) :: SECLEFT
+ !
+ !  SUBROUTINE SYSTEM(STRING,STATUS,ERRNO)
+ !    CHARACTER*(*),INTENT(IN) :: STRING
+ !    INTEGER,OPTIONAL,INTENT(OUT) :: STATUS,ERRNO
+ !
+ !!also used in exit_all outside this module
+ !  SUBROUTINE EXIT(STATUS)
+ !    INTEGER,OPTIONAL :: STATUS
+ !! end block
 ! !!NAG_BLOCK_EDIT END COMMENTED_OUT
 
 implicit none
@@ -92,7 +105,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
@@ -108,7 +121,7 @@
 integer :: head_task = 0         ! def 0, but N-1 if reverse_task_layout true
 logical :: print4status = .true. ! minimal messages for async4 handshake
 
-character(len = 256) :: errstring
+character(len = 256) :: errstring, errstring1
 
 ! for broadcasts, pack small messages into larger ones.  remember that the
 ! byte size will be this count * 8 because we only communicate r8s.  (unless
@@ -1753,6 +1766,27 @@
 
 !-----------------------------------------------------------------------------
 !-----------------------------------------------------------------------------
+! Collect sum across tasks for a given array.
+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)
 

Modified: DART/branches/recam/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
===================================================================
--- DART/branches/recam/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90	2018-09-18 14:01:17 UTC (rev 12829)
+++ DART/branches/recam/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90	2018-09-18 14:07:08 UTC (rev 12830)
@@ -19,6 +19,19 @@
 
 ! !!NAG_BLOCK_EDIT START COMMENTED_OUT
 ! use F90_unix_proc, only : sleep, system, exit
+ !! block for NAG compiler
+ !  PURE SUBROUTINE SLEEP(SECONDS,SECLEFT)
+ !    INTEGER,INTENT(IN) :: SECONDS
+ !    INTEGER,OPTIONAL,INTENT(OUT) :: SECLEFT
+ !
+ !  SUBROUTINE SYSTEM(STRING,STATUS,ERRNO)
+ !    CHARACTER*(*),INTENT(IN) :: STRING
+ !    INTEGER,OPTIONAL,INTENT(OUT) :: STATUS,ERRNO
+ !
+ !!also used in exit_all outside this module
+ !  SUBROUTINE EXIT(STATUS)
+ !    INTEGER,OPTIONAL :: STATUS
+ !! end block
 ! !!NAG_BLOCK_EDIT END COMMENTED_OUT
 
 
@@ -36,12 +49,12 @@
 ! !!SYSTEM_BLOCK_EDIT START COMMENTED_OUT
 ! ! interface block for getting return code back from system() routine
 ! interface
-!  function system(string)    
+!  function system(string)