LCOV - code coverage report
Current view: | top level - dynamics/se/dycore - reduction_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 71 | 124 | 57.3 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 9 | 17 | 52.9 %

              Line data    Source code
           1             : module reduction_mod
           2             :   use shr_kind_mod,   only: r8=>shr_kind_r8
           3             :   use spmd_utils,     only: mpi_sum, mpi_min, mpi_max, mpi_real8, mpi_integer
           4             :   use spmd_utils,     only: mpi_success
           5             :   use cam_abortutils, only: endrun
           6             :
           7             :   implicit none
           8             :   private
           9             :
          10             :   type, public :: ReductionBuffer_int_1d_t
          11             :      integer, dimension(:), pointer :: buf
          12             :      integer :: len=0
          13             :      integer :: ctr
          14             :   end type ReductionBuffer_int_1d_t
          15             :
          16             :   type, public :: ReductionBuffer_r_1d_t
          17             :      real (kind=r8), dimension(:), pointer :: buf
          18             :      integer :: len=0
          19             :      integer :: ctr
          20             :   end type ReductionBuffer_r_1d_t
          21             :
          22             :   type, public :: ReductionBuffer_ordered_1d_t
          23             :      real (kind=r8), dimension(:,:),pointer :: buf
          24             :      integer :: len=0
          25             :      integer :: ctr
          26             :   end type ReductionBuffer_ordered_1d_t
          27             :
          28             :   public :: ParallelMin
          29             :   public :: ParallelMax
          30             :
          31             :   type (ReductionBuffer_int_1d_t), public :: red_max_int
          32             :   type (ReductionBuffer_int_1d_t), public :: red_sum_int
          33             :   type (ReductionBuffer_r_1d_t),   public :: red_flops
          34             :   type (ReductionBuffer_r_1d_t),   public :: red_max
          35             :   type (ReductionBuffer_r_1d_t),   public :: red_min
          36             :   type (ReductionBuffer_r_1d_t),   public :: red_sum
          37             : #ifndef Darwin
          38             :   SAVE red_max_int, red_sum_int, red_flops, red_max, red_min, red_sum
          39             : #endif
          40             :
          41             :   interface ParallelMin
          42             :      module procedure ParallelMin1d
          43             :      module procedure ParallelMin0d
          44             :   end interface
          45             :   interface ParallelMax
          46             :      module procedure ParallelMax1d_int
          47             :      module procedure ParallelMax2d_int
          48             :      module procedure ParallelMax1d
          49             :      module procedure ParallelMax0d
          50             :      module procedure ParallelMax0d_int
          51             :   end interface
          52             :
          53             :   interface pmax_mt
          54             :      module procedure pmax_mt_int_1d
          55             :      module procedure pmax_mt_r_1d
          56             :   end interface
          57             :
          58             :   interface pmin_mt
          59             :      module procedure pmin_mt_r_1d
          60             :   end interface
          61             :
          62             :   interface InitReductionBuffer
          63             :      module procedure InitReductionBuffer_int_1d
          64             :      module procedure InitReductionBuffer_r_1d
          65             :      module procedure InitReductionBuffer_ordered_1d
          66             :   end interface
          67             :
          68             :   public :: InitReductionBuffer
          69             :   public :: pmax_mt, pmin_mt
          70             :   public :: ElementSum_1d
          71             :
          72             : contains
          73             :
          74      168960 :   function ParallelMin1d(data,hybrid) result(pmin)
          75             :     use hybrid_mod, only : hybrid_t
          76             :
          77             :     real(kind=r8),   intent(in) :: data(:)
          78             :     type (hybrid_t), intent(in) :: hybrid
          79             :     real(kind=r8)               :: pmin
          80             :
          81             :     real(kind=r8)               :: tmp(1)
          82             :
          83             :
          84     1525920 :     tmp(1) = MINVAL(data)
          85      168960 :     call pmin_mt(red_min,tmp,1,hybrid)
          86      168960 :     pmin = red_min%buf(1)
          87             :
          88      168960 :   end function ParallelMin1d
          89             :
          90        6144 :   function ParallelMin0d(data,hybrid) result(pmin)
          91             :     use hybrid_mod, only : hybrid_t
          92             :     implicit none
          93             :     real(kind=r8), intent(in)    :: data
          94             :     type (hybrid_t),      intent(in)    :: hybrid
          95             :     real(kind=r8)                :: pmin
          96             :     real(kind=r8)                :: tmp(1)
          97        6144 :     tmp(1) = data
          98        6144 :     call pmin_mt(red_min,tmp,1,hybrid)
          99        6144 :     pmin = red_min%buf(1)
         100             :
         101        6144 :   end function ParallelMin0d
         102             :   !==================================================
         103           0 :   function ParallelMax2d_int(data, n, m, hybrid) result(pmax)
         104             :     use hybrid_mod, only : hybrid_t
         105             :     implicit none
         106             :     integer, intent(in)                 :: n,m
         107             :     integer, intent(in), dimension(n,m) :: data
         108             :     type (hybrid_t), intent(in)         :: hybrid
         109             :     integer, dimension(n,m)             :: pmax
         110           0 :     integer, dimension(n*m)             :: tmp
         111             :     integer :: i,j
         112           0 :     do i=1,n
         113           0 :       do j=1,m
         114           0 :         tmp(i+(j-1)*n) = data(i,j)
         115             :       enddo
         116             :     enddo
         117           0 :     call pmax_mt(red_max_int,tmp,n*m,hybrid)
         118           0 :     do i=1,n
         119           0 :       do j=1,m
         120           0 :         pmax(i,j) = red_max_int%buf(i+(j-1)*n)
         121             :       enddo
         122             :     enddo
         123           0 :   end function ParallelMax2d_int
         124             :
         125           0 :   function ParallelMax1d_int(data, len, hybrid) result(pmax)
         126             :     use hybrid_mod, only : hybrid_t
         127             :     implicit none
         128             :     integer, intent(in)                 :: len
         129             :     integer, intent(in), dimension(len) :: data
         130             :     type (hybrid_t), intent(in)         :: hybrid
         131           0 :     integer, dimension(len)             :: pmax, tmp
         132             :
         133           0 :     tmp = data(:)
         134           0 :     call pmax_mt(red_max_int,tmp,len,hybrid)
         135           0 :     pmax(:) = red_max_int%buf(1:len)
         136             :
         137           0 :   end function ParallelMax1d_int
         138      168960 :   function ParallelMax1d(data,hybrid) result(pmax)
         139             :     use hybrid_mod, only : hybrid_t
         140             :     implicit none
         141             :     real(kind=r8), intent(in)    :: data(:)
         142             :     type (hybrid_t),      intent(in)    :: hybrid
         143             :     real(kind=r8)                :: pmax
         144             :
         145             :     real(kind=r8)                :: tmp(1)
         146             :
         147             :
         148     1525920 :     tmp(1) = MAXVAL(data)
         149      168960 :     call pmax_mt(red_max,tmp,1,hybrid)
         150      168960 :     pmax = red_max%buf(1)
         151             :
         152      168960 :   end function ParallelMax1d
         153        6144 :   function ParallelMax0d(data,hybrid) result(pmax)
         154             :     use hybrid_mod, only : hybrid_t
         155             :     implicit none
         156             :     real(kind=r8), intent(in)    :: data
         157             :     type (hybrid_t),      intent(in)    :: hybrid
         158             :     real(kind=r8)                :: pmax
         159             :     real(kind=r8)                :: tmp(1)
         160             :
         161        6144 :     tmp(1)=data
         162             :
         163        6144 :     call pmax_mt(red_max,tmp,1,hybrid)
         164        6144 :     pmax = red_max%buf(1)
         165             :
         166        6144 :   end function ParallelMax0d
         167           0 :   function ParallelMax0d_int(data,hybrid) result(pmax)
         168             :     use hybrid_mod, only : hybrid_t
         169             :     implicit none
         170             :     integer             , intent(in)    :: data
         171             :     type (hybrid_t),      intent(in)    :: hybrid
         172             :     integer                             :: pmax
         173             :     integer                             :: tmp(1)
         174             :
         175           0 :     tmp(1)=data
         176             :
         177           0 :     call pmax_mt(red_max_int,tmp,1,hybrid)
         178           0 :     pmax = red_max_int%buf(1)
         179             :
         180           0 :   end function ParallelMax0d_int
         181             :   !==================================================
         182        3072 :   subroutine InitReductionBuffer_int_1d(red,len)
         183             :     use thread_mod, only: omp_get_num_threads
         184             :     integer, intent(in)           :: len
         185             :     type (ReductionBuffer_int_1d_t),intent(out) :: red
         186             :
         187        3072 :     if (omp_get_num_threads()>1) then
         188           0 :        call endrun("Error: attempt to allocate reduction buffer in threaded region")
         189             :     endif
         190             :
         191             :     ! if buffer is already allocated and large enough, do nothing
         192        3072 :     if (len > red%len) then
         193             :        !buffer is too small, or has not yet been allocated
         194        3072 :        if (red%len>0) deallocate(red%buf)
         195        3072 :        red%len  = len
         196        9216 :        allocate(red%buf(len))
         197        6144 :        red%buf  = 0
         198        3072 :        red%ctr  = 0
         199             :     endif
         200             :
         201        3072 :   end subroutine InitReductionBuffer_int_1d
         202             :   !****************************************************************
         203        6144 :   subroutine InitReductionBuffer_r_1d(red,len)
         204             :     use thread_mod, only: omp_get_num_threads
         205             :     integer, intent(in)           :: len
         206             :     type (ReductionBuffer_r_1d_t),intent(out) :: red
         207             :
         208        6144 :     if (omp_get_num_threads()>1) then
         209           0 :        call endrun("Error: attempt to allocate reduction buffer in threaded region")
         210             :     endif
         211             :
         212        6144 :     if (len > red%len) then
         213        6144 :        if (red%len>0) deallocate(red%buf)
         214        6144 :        red%len  = len
         215       18432 :        allocate(red%buf(len))
         216       18432 :        red%buf  = 0.0_R8
         217        6144 :        red%ctr  = 0
         218             :     endif
         219        6144 :   end subroutine InitReductionBuffer_r_1d
         220             :   !****************************************************************
         221        1536 :   subroutine InitReductionBuffer_ordered_1d(red,len,nthread)
         222             :     use thread_mod, only: omp_get_num_threads
         223             :     integer, intent(in)           :: len
         224             :     integer, intent(in)           :: nthread
         225             :     type (ReductionBuffer_ordered_1d_t),intent(out) :: red
         226             :
         227        1536 :     if (omp_get_num_threads()>1) then
         228           0 :        call endrun("Error: attempt to allocate reduction buffer in threaded region")
         229             :     endif
         230             :
         231        1536 :     if (len > red%len) then
         232        1536 :        if (red%len>0) deallocate(red%buf)
         233        1536 :        red%len  = len
         234        6144 :        allocate(red%buf(len,nthread+1))
         235      861696 :        red%buf  = 0.0_R8
         236        1536 :        red%ctr  = 0
         237             :     endif
         238        1536 :   end subroutine InitReductionBuffer_ordered_1d
         239             :
         240             :   ! =======================================
         241             :   ! pmax_mt:
         242             :   !
         243             :   ! thread safe, parallel reduce maximum
         244             :   ! of a one dimensional reduction vector
         245             :   ! =======================================
         246             :
         247           0 :   subroutine pmax_mt_int_1d(red,redp,len,hybrid)
         248             :     use hybrid_mod, only : hybrid_t
         249             :
         250             :     type (ReductionBuffer_int_1d_t)   :: red       ! shared memory reduction buffer struct
         251             :     integer,               intent(in) :: len       ! buffer length
         252             :     integer, intent(inout)            :: redp(len) ! thread private vector of partial sum
         253             :     type (hybrid_t),       intent(in) :: hybrid    ! parallel handle
         254             :
         255             :     ! Local variables
         256             : #ifdef _MPI
         257             :     integer ierr
         258             : #endif
         259             :
         260             :     integer  :: k
         261           0 :     if (len>red%len) then
         262           0 :       call endrun('ERROR: threadsafe reduction buffer too small')
         263             :     end if
         264             :
         265             :     !$OMP BARRIER
         266             :     !$OMP CRITICAL (CRITMAX)
         267           0 :     if (red%ctr == 0) red%buf(1:len)= -9999
         268           0 :     if (red%ctr < hybrid%NThreads) then
         269           0 :        do k=1,len
         270           0 :           red%buf(k)=MAX(red%buf(k),redp(k))
         271             :        enddo
         272           0 :        red%ctr=red%ctr+1
         273             :     end if
         274           0 :     if (red%ctr == hybrid%NThreads) red%ctr=0
         275             :     !$OMP END CRITICAL (CRITMAX)
         276             : #ifdef _MPI
         277             :     !$OMP BARRIER
         278           0 :     if (hybrid%ithr==0) then
         279             :
         280           0 :        call MPI_Allreduce(red%buf(1),redp,len,Mpi_integer, &
         281           0 :             MPI_MAX,hybrid%par%comm,ierr)
         282             :
         283           0 :        red%buf(1:len)=redp(1:len)
         284             :     end if
         285             : #endif
         286             :     !$OMP BARRIER
         287             :
         288           0 :   end subroutine pmax_mt_int_1d
         289             :
         290      175104 :   subroutine pmax_mt_r_1d(red,redp,len,hybrid)
         291             :     use hybrid_mod, only : hybrid_t
         292             :
         293             :     type (ReductionBuffer_r_1d_t)     :: red     ! shared memory reduction buffer struct
         294             :     real (kind=r8), intent(inout) :: redp(:) ! thread private vector of partial sum
         295             :     integer,               intent(in) :: len     ! buffer length
         296             :     type (hybrid_t),       intent(in) :: hybrid  ! parallel handle
         297             :
         298             :     ! Local variables
         299             : #ifdef _MPI
         300             :     integer ierr
         301             : #endif
         302             :
         303             :     integer  :: k
         304      175104 :     if (len>red%len) then
         305           0 :       call endrun('ERROR: threadsafe reduction buffer too small')
         306             :     end if
         307             :
         308             :     !$OMP BARRIER
         309             :     !$OMP CRITICAL (CRITMAX)
         310      350208 :     if (red%ctr == 0) red%buf(1:len)= -9.11e30_r8
         311      175104 :     if (red%ctr < hybrid%NThreads) then
         312      350208 :        do k=1,len
         313      350208 :           red%buf(k)=MAX(red%buf(k),redp(k))
         314             :        enddo
         315      175104 :        red%ctr=red%ctr+1
         316             :     end if
         317      175104 :     if (red%ctr == hybrid%NThreads) red%ctr=0
         318             :     !$OMP END CRITICAL (CRITMAX)
         319             : #ifdef _MPI
         320             :     !$OMP BARRIER
         321      175104 :     if (hybrid%ithr==0) then
         322             :
         323           0 :        call MPI_Allreduce(red%buf(1),redp,len,Mpi_real8, &
         324      175104 :             MPI_MAX,hybrid%par%comm,ierr)
         325             :
         326      350208 :        red%buf(1:len)=redp(1:len)
         327             :     end if
         328             : #endif
         329             :     !$OMP BARRIER
         330             :
         331      175104 :   end subroutine pmax_mt_r_1d
         332             :
         333             :   ! =======================================
         334             :   ! pmin_mt:
         335             :   !
         336             :   ! thread safe, parallel reduce maximum
         337             :   ! of a one dimensional reduction vector
         338             :   ! =======================================
         339             :
         340      175104 :   subroutine pmin_mt_r_1d(red,redp,len,hybrid)
         341             :     use hybrid_mod, only : hybrid_t
         342             :
         343             :     type (ReductionBuffer_r_1d_t)     :: red     ! shared memory reduction buffer struct
         344             :     real (kind=r8), intent(inout) :: redp(:) ! thread private vector of partial sum
         345             :     integer,               intent(in) :: len     ! buffer length
         346             :     type (hybrid_t),       intent(in) :: hybrid  ! parallel handle
         347             :
         348             :     ! Local variables
         349             :
         350             : #ifdef _MPI
         351             :     integer :: ierr
         352             : #endif
         353             :     integer :: k
         354             :
         355      175104 :     if (len>red%len) then
         356           0 :       call endrun('ERROR: threadsafe reduction buffer too small')
         357             :     end if
         358             :
         359             :     !$OMP BARRIER
         360             :     !$OMP CRITICAL (CRITMAX)
         361      350208 :     if (red%ctr == 0) red%buf(1:len)= 9.11e30_r8
         362      175104 :     if (red%ctr < hybrid%NThreads) then
         363      350208 :        do k=1,len
         364      350208 :           red%buf(k)=MIN(red%buf(k),redp(k))
         365             :        enddo
         366      175104 :        red%ctr=red%ctr+1
         367             :     end if
         368      175104 :     if (red%ctr == hybrid%NThreads) red%ctr=0
         369             :     !$OMP END CRITICAL (CRITMAX)
         370             : #ifdef _MPI
         371             :     !$OMP BARRIER
         372      175104 :     if (hybrid%ithr==0) then
         373             :
         374           0 :        call MPI_Allreduce(red%buf(1),redp,len,Mpi_real8, &
         375      175104 :             MPI_MIN,hybrid%par%comm,ierr)
         376             :
         377      350208 :        red%buf(1:len)=redp(1:len)
         378             :     end if
         379             : #endif
         380             :     !$OMP BARRIER
         381             :
         382      175104 :   end subroutine pmin_mt_r_1d
         383             :
         384           0 :   subroutine ElementSum_1d(res,variable,type,hybrid)
         385             :     use hybrid_mod,     only: hybrid_t
         386             :     use dimensions_mod, only: nelem
         387             :     use parallel_mod,   only: ORDERED
         388             :
         389             :     ! ==========================
         390             :     !     Arguments
         391             :     ! ==========================
         392             :     real(kind=r8),   intent(out) :: res
         393             :     real(kind=r8),   intent(in)  :: variable(:)
         394             :     integer,         intent(in)  :: type
         395             :     type (hybrid_t), intent(in)  :: hybrid
         396             :
         397             :     ! ==========================
         398             :     !       Local Variables
         399             :     ! ==========================
         400             :
         401             :     !
         402             :     ! Note this is a real kludge here since it may be used for
         403             :     !  arrays of size other then nelem
         404             :     !
         405             :
         406             : #ifdef _MPI
         407             :     integer           :: errorcode,errorlen
         408             :     character(len=80) :: errorstring
         409             :
         410             :     real(kind=r8)     :: local_sum
         411             :     integer           :: ierr
         412             : #else
         413             :     integer           :: i
         414             : #endif
         415             :
         416             : #ifdef _MPI
         417           0 :     if(hybrid%ithr == 0) then
         418           0 :           local_sum=SUM(variable)
         419           0 :           call MPI_Barrier(hybrid%par%comm,ierr)
         420             :
         421             :           call MPI_Allreduce(local_sum,res,1,Mpi_real8, &
         422           0 :                MPI_SUM,hybrid%par%comm,ierr)
         423           0 :           if(ierr .ne. MPI_SUCCESS) then
         424           0 :              errorcode=ierr
         425           0 :              call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         426           0 :              print *,'ElementSum_1d: Error after call to MPI_Allreduce: ',errorstring
         427             :           endif
         428             :     endif
         429             : #else
         430             :     if(hybrid%ithr == 0) then
         431             :        if(type == ORDERED) then
         432             :           ! ===========================
         433             :           !  Perform the ordererd sum
         434             :           ! ===========================
         435             :           res = 0.0_r8
         436             :           do i=1,nelem
         437             :              res = res + variable(i)
         438             :           enddo
         439             :        else
         440             :           res=SUM(variable)
         441             :        endif
         442             :     endif
         443             : #endif
         444             :
         445           0 :   end subroutine ElementSum_1d
         446             :
         447           0 : end module reduction_mod

Generated by: LCOV version 1.14