From 660ab51d3e3afe2ddfc16ea6ebbff3f324b6e99e Mon Sep 17 00:00:00 2001
From: Michael Duda <duda@ucar.edu>
Date: Mon, 8 Jul 2024 17:54:18 -0600
Subject: [PATCH] Add mpas_dmpar_bcast_real4s routine for broadcasting
 real(kind=R4KIND) arrays

This commit adds a new routine to the dmpar module for broadcasing
real(kind=R4KIND) arrays.  The new mpas_dmpar_bcast_real4s routine mirrors the
mpas_dmpar_bcast_reals routine, with the dummy array argument being of R4KIND
rather than RKIND kind.
---
 src/framework/mpas_dmpar.F | 41 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

diff --git a/src/framework/mpas_dmpar.F b/src/framework/mpas_dmpar.F
index 0addb63ed0..6d68c0c656 100644
--- a/src/framework/mpas_dmpar.F
+++ b/src/framework/mpas_dmpar.F
@@ -98,6 +98,7 @@ module mpas_dmpar
    public :: mpas_dmpar_bcast_ints
    public :: mpas_dmpar_bcast_real
    public :: mpas_dmpar_bcast_reals
+   public :: mpas_dmpar_bcast_real4s
    public :: mpas_dmpar_bcast_double
    public :: mpas_dmpar_bcast_doubles
    public :: mpas_dmpar_bcast_logical
@@ -551,6 +552,46 @@ subroutine mpas_dmpar_bcast_reals(dminfo, n, rarray, proc)!{{{
 
    end subroutine mpas_dmpar_bcast_reals!}}}
 
+!-----------------------------------------------------------------------
+!  routine mpas_dmpar_bcast_real4s
+!
+!> \brief MPAS dmpar broadcast R4KIND routine.
+!> \author Michael Duda, William Lipscomb
+!> \date 8 July 2024
+!> \details
+!>  This routine broadcasts an array of R4KIND reals to all processors in
+!>  the communicator. An optional argument specifies the source node; else
+!>  broadcast from IO_NODE.
+!
+!-----------------------------------------------------------------------
+   subroutine mpas_dmpar_bcast_real4s(dminfo, n, rarray, proc)!{{{
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo !< Input: Domain information
+      integer, intent(in) :: n !< Input: Length of array
+      real (kind=R4KIND), dimension(n), intent(inout) :: rarray !< Input/Output: Array of reals to be broadcast
+      integer, intent(in), optional :: proc  !< optional argument indicating which processor to broadcast from
+
+#ifdef _MPI
+      integer :: mpi_ierr, source
+      integer :: threadNum
+
+      threadNum = mpas_threading_get_thread_num()
+
+      if ( threadNum == 0 ) then
+         if (present(proc)) then
+            source = proc
+         else
+            source = IO_NODE
+         endif
+
+         call MPI_Bcast(rarray, n, MPI_REAL, source, dminfo % comm, mpi_ierr)
+      end if
+#endif
+
+   end subroutine mpas_dmpar_bcast_real4s!}}}
+
 !-----------------------------------------------------------------------
 !  routine mpas_dmpar_bcast_double
 !