From 02f81aaa737b1e8ae5a0dd6ec41ef02ae3c3a7ea Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 7 Jan 2025 09:46:28 -0500 Subject: [PATCH 1/3] Fixes #3289. This commit fixes the behavior of MAPL_MaxMin in presence of NaN. --- CHANGELOG.md | 1 + base/MAPL_MaxMinMod.F90 | 51 +++++++++++++++++------------------------ 2 files changed, 22 insertions(+), 30 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 74d6483ad4bd..6e91ff35fbd3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed the behavior of MAPL_MaxMin in presence of NaN - Fixed bug with return codes and macros in udunits2f ### Removed diff --git a/base/MAPL_MaxMinMod.F90 b/base/MAPL_MaxMinMod.F90 index 8aa0bef53b4e..ac22df044890 100644 --- a/base/MAPL_MaxMinMod.F90 +++ b/base/MAPL_MaxMinMod.F90 @@ -8,7 +8,7 @@ ! ! Author: GMAO SI-Team ! -! `MAPL_MaxMinMo` --- Global Max/Min of Arrays +! `MAPL_MaxMinMod` --- Global Max/Min of Arrays ! ! This module implements functions for calculating/printing out the global min/max ! of fortran arrays. Derived from GEOS-4 pmaxmin() functions. @@ -20,6 +20,7 @@ module MAPL_MaxMinMod Use ESMF Use MAPL_CommsMod + Use mpi implicit None @@ -66,21 +67,17 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) real(ESMF_KIND_R4) :: pmax, pmin, fac - integer :: im, jt - integer :: i, j, two=2 - real, allocatable :: qmin(:), qmax(:) real pm1(2) real pm_res(2) type(ESMF_VM) :: vm character(len=16) :: name +!NOTE: the current version does not trap error conditions returned in status integer :: status - - im = size(a,1) - jt = size(a,2) - allocate(qmin(jt),qmax(jt)) + integer :: comm + logical :: has_nans, hn if ( present(fac_) ) then fac = fac_ @@ -90,25 +87,10 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) call ESMF_VmGetCurrent(vm=vm, rc=status) - do j=1,jt - pmax = a(1,j) - pmin = a(1,j) - do i=2,im - pmax = max(pmax, a(i,j)) - pmin = min(pmin, a(i,j)) - enddo - qmax(j) = pmax - qmin(j) = pmin - enddo -! -! Now find max/min of amax/amin -! - pmax = qmax(1) - pmin = qmin(1) - do j=2,jt - pmax = max(pmax, qmax(j)) - pmin = min(pmin, qmin(j)) - enddo + has_nans = any(a /= a) + + pmin = minval(a, mask=(a==a)) + pmax = maxval(a, mask=(a==a)) pm1(1) = pmax pm1(2) = -pmin @@ -118,13 +100,22 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) if ( present(pmax_) ) pmax_ = pmax if ( present(pmin_) ) pmin_ = pmin - deallocate(qmax,qmin) + + call ESMF_VmGet(VM, mpicommunicator=comm, rc=status) + call MPI_Reduce(has_nans, hn, 1, MPI_LOGICAL, MPI_LOR, 0, comm, status) +! call MPI_Reduce(sendbuf=has_nans, recvbuf=hn, count=1, & +! datatype=MPI_LOGICAL, op=MPI_LOR, root=0, comm=comm, ierror=status) if ( fac /= 0.0 ) then ! trick to prevent printing - if ( MAPL_am_I_root() ) then + if ( MAPL_am_I_root(vm) ) then name = ' ' name(1:len(qname)) = qname - write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac + if (hn) then + write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac, & + ' has NaN' + else + write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac + end if return end if end if From 4916c93617f6002520a54ed69327f5d1ccb2d2ad Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 7 Jan 2025 14:41:31 -0500 Subject: [PATCH 2/3] Adopted suggestions from PR review --- base/MAPL_MaxMinMod.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/base/MAPL_MaxMinMod.F90 b/base/MAPL_MaxMinMod.F90 index ac22df044890..bea52379b2c1 100644 --- a/base/MAPL_MaxMinMod.F90 +++ b/base/MAPL_MaxMinMod.F90 @@ -77,7 +77,9 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) !NOTE: the current version does not trap error conditions returned in status integer :: status integer :: comm - logical :: has_nans, hn + logical :: has_nans + logical :: has_nans_local + character(len=:), allocatable :: buf if ( present(fac_) ) then fac = fac_ @@ -87,7 +89,7 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) call ESMF_VmGetCurrent(vm=vm, rc=status) - has_nans = any(a /= a) + has_nans_local = any(a /= a) pmin = minval(a, mask=(a==a)) pmax = maxval(a, mask=(a==a)) @@ -102,20 +104,19 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) if ( present(pmin_) ) pmin_ = pmin call ESMF_VmGet(VM, mpicommunicator=comm, rc=status) - call MPI_Reduce(has_nans, hn, 1, MPI_LOGICAL, MPI_LOR, 0, comm, status) -! call MPI_Reduce(sendbuf=has_nans, recvbuf=hn, count=1, & + call MPI_Reduce(has_nans_local, has_nans, 1, MPI_LOGICAL, MPI_LOR, 0, comm, status) +! call MPI_Reduce(sendbuf=MPI_IN_PLACE, recvbuf=has_nans, count=1, & ! datatype=MPI_LOGICAL, op=MPI_LOR, root=0, comm=comm, ierror=status) if ( fac /= 0.0 ) then ! trick to prevent printing if ( MAPL_am_I_root(vm) ) then name = ' ' name(1:len(qname)) = qname - if (hn) then - write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac, & - ' has NaN' - else - write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac + buf = "" + if (has_nans) then + buf = " has NaN" end if + write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac, buf return end if end if From 65f9f56ec48c700219943452a38927fb9be06b18 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 7 Jan 2025 14:48:54 -0500 Subject: [PATCH 3/3] Update base/MAPL_MaxMinMod.F90 --- base/MAPL_MaxMinMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/base/MAPL_MaxMinMod.F90 b/base/MAPL_MaxMinMod.F90 index bea52379b2c1..e63f45866191 100644 --- a/base/MAPL_MaxMinMod.F90 +++ b/base/MAPL_MaxMinMod.F90 @@ -105,8 +105,6 @@ subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ ) call ESMF_VmGet(VM, mpicommunicator=comm, rc=status) call MPI_Reduce(has_nans_local, has_nans, 1, MPI_LOGICAL, MPI_LOR, 0, comm, status) -! call MPI_Reduce(sendbuf=MPI_IN_PLACE, recvbuf=has_nans, count=1, & -! datatype=MPI_LOGICAL, op=MPI_LOR, root=0, comm=comm, ierror=status) if ( fac /= 0.0 ) then ! trick to prevent printing if ( MAPL_am_I_root(vm) ) then