MAPL_MaxMinMod.F90 Source File


This file depends on

sourcefile~~mapl_maxminmod.f90~~EfferentGraph sourcefile~mapl_maxminmod.f90 MAPL_MaxMinMod.F90 sourcefile~mapl_comms.f90 MAPL_Comms.F90 sourcefile~mapl_maxminmod.f90->sourcefile~mapl_comms.f90 sourcefile~base_base.f90 Base_Base.F90 sourcefile~mapl_comms.f90->sourcefile~base_base.f90 sourcefile~constants.f90 Constants.F90 sourcefile~mapl_comms.f90->sourcefile~constants.f90 sourcefile~mapl_exceptionhandling.f90 MAPL_ExceptionHandling.F90 sourcefile~mapl_comms.f90->sourcefile~mapl_exceptionhandling.f90 sourcefile~shmem.f90 Shmem.F90 sourcefile~mapl_comms.f90->sourcefile~shmem.f90 sourcefile~base_base.f90->sourcefile~constants.f90 sourcefile~mapl_keywordenforcer.f90 MAPL_KeywordEnforcer.F90 sourcefile~base_base.f90->sourcefile~mapl_keywordenforcer.f90 sourcefile~mapl_range.f90 MAPL_Range.F90 sourcefile~base_base.f90->sourcefile~mapl_range.f90 sourcefile~maplgrid.f90 MaplGrid.F90 sourcefile~base_base.f90->sourcefile~maplgrid.f90 sourcefile~internalconstants.f90 InternalConstants.F90 sourcefile~constants.f90->sourcefile~internalconstants.f90 sourcefile~mathconstants.f90 MathConstants.F90 sourcefile~constants.f90->sourcefile~mathconstants.f90 sourcefile~physicalconstants.f90 PhysicalConstants.F90 sourcefile~constants.f90->sourcefile~physicalconstants.f90 sourcefile~mapl_errorhandling.f90 MAPL_ErrorHandling.F90 sourcefile~mapl_exceptionhandling.f90->sourcefile~mapl_errorhandling.f90 sourcefile~mapl_throw.f90 MAPL_Throw.F90 sourcefile~mapl_exceptionhandling.f90->sourcefile~mapl_throw.f90 sourcefile~shmem.f90->sourcefile~constants.f90 sourcefile~mapl_errorhandling.f90->sourcefile~mapl_throw.f90 sourcefile~mapl_range.f90->sourcefile~mapl_exceptionhandling.f90 sourcefile~maplgrid.f90->sourcefile~constants.f90 sourcefile~maplgrid.f90->sourcefile~mapl_errorhandling.f90 sourcefile~maplgrid.f90->sourcefile~mapl_keywordenforcer.f90 sourcefile~mapl_sort.f90 MAPL_Sort.F90 sourcefile~maplgrid.f90->sourcefile~mapl_sort.f90 sourcefile~pflogger_stub.f90 pflogger_stub.F90 sourcefile~maplgrid.f90->sourcefile~pflogger_stub.f90 sourcefile~physicalconstants.f90->sourcefile~mathconstants.f90

Files dependent on this one

sourcefile~~mapl_maxminmod.f90~~AfferentGraph sourcefile~mapl_maxminmod.f90 MAPL_MaxMinMod.F90 sourcefile~base.f90 Base.F90 sourcefile~base.f90->sourcefile~mapl_maxminmod.f90 sourcefile~mapl_simplebundlemod.f90 MAPL_SimpleBundleMod.F90 sourcefile~base.f90->sourcefile~mapl_simplebundlemod.f90 sourcefile~mapl_simplebundlemod.f90->sourcefile~mapl_maxminmod.f90 sourcefile~mapl.f90 MAPL.F90 sourcefile~mapl.f90->sourcefile~base.f90 sourcefile~mapl_nuopcwrappermod.f90 MAPL_NUOPCWrapperMod.F90 sourcefile~mapl_nuopcwrappermod.f90->sourcefile~base.f90 sourcefile~test_cfio_bundle.pf Test_CFIO_Bundle.pf sourcefile~test_cfio_bundle.pf->sourcefile~base.f90 sourcefile~tstqsat.f90 tstqsat.F90 sourcefile~tstqsat.f90->sourcefile~base.f90 sourcefile~ut_extdata.f90 ut_ExtData.F90 sourcefile~ut_extdata.f90->sourcefile~base.f90 sourcefile~utcfio_bundle.f90 utCFIO_Bundle.F90 sourcefile~utcfio_bundle.f90->sourcefile~base.f90 sourcefile~capdriver.f90 CapDriver.F90 sourcefile~capdriver.f90->sourcefile~mapl.f90 sourcefile~extdataroot_gridcomp.f90 ExtDataRoot_GridComp.F90 sourcefile~capdriver.f90->sourcefile~extdataroot_gridcomp.f90 sourcefile~comp_testing_driver.f90 Comp_Testing_Driver.F90 sourcefile~comp_testing_driver.f90->sourcefile~mapl.f90 sourcefile~extdatadriver.f90 ExtDataDriver.F90 sourcefile~extdatadriver.f90->sourcefile~mapl.f90 sourcefile~extdatadrivergridcomp.f90 ExtDataDriverGridComp.F90 sourcefile~extdatadriver.f90->sourcefile~extdatadrivergridcomp.f90 sourcefile~extdatadrivermod.f90 ExtDataDriverMod.F90 sourcefile~extdatadriver.f90->sourcefile~extdatadrivermod.f90 sourcefile~extdatadriver.f90->sourcefile~extdataroot_gridcomp.f90 sourcefile~extdatadrivergridcomp.f90->sourcefile~mapl.f90 sourcefile~extdatadrivermod.f90->sourcefile~mapl.f90 sourcefile~extdatadrivermod.f90->sourcefile~extdatadrivergridcomp.f90 sourcefile~extdatadrivermod.f90->sourcefile~extdataroot_gridcomp.f90 sourcefile~extdataroot_gridcomp.f90->sourcefile~mapl.f90 sourcefile~varspecdescription.f90 VarspecDescription.F90 sourcefile~extdataroot_gridcomp.f90->sourcefile~varspecdescription.f90 sourcefile~mapl_demo_fargparse.f90 MAPL_demo_fargparse.F90 sourcefile~mapl_demo_fargparse.f90->sourcefile~mapl.f90 sourcefile~pfio_mapl_demo.f90 pfio_MAPL_demo.F90 sourcefile~pfio_mapl_demo.f90->sourcefile~mapl.f90 sourcefile~regrid_util.f90 Regrid_Util.F90 sourcefile~regrid_util.f90->sourcefile~mapl.f90 sourcefile~time_ave_util.f90 time_ave_util.F90 sourcefile~time_ave_util.f90->sourcefile~mapl.f90 sourcefile~varspecdescription.f90->sourcefile~mapl.f90

Source Code

!------------------------------------------------------------------------------
!               Global Modeling and Assimilation Office (GMAO)                !
!                    Goddard Earth Observing System (GEOS)                    !
!                                 MAPL Component                              !
!------------------------------------------------------------------------------
!>
!### MODULE: `MAPL_MaxMinMod`
!
! Author: GMAO SI-Team
!
! `MAPL_MaxMinMo` --- 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.
!
   module MAPL_MaxMinMod


! !USES:

      Use ESMF
      Use MAPL_CommsMod

      implicit None

! !PUBLIC MEMBER FUNCTIONS:
!
      private
      public  MAPL_MaxMin

      interface MAPL_MaxMin

         module procedure pmaxmin3d_r4
         module procedure pmaxmin2d_r4
         module procedure pmaxmin1d_r4

         module procedure pmaxmin3d_r8
         module procedure pmaxmin2d_r8
         module procedure pmaxmin1d_r8

      end interface MAPL_MaxMin

CONTAINS

  subroutine pmaxmin3d_r4 ( qname, a, pmin, pmax, fac )
      implicit none
      character(len=*),             intent(in)  :: qname        ! label to print
      real(ESMF_KIND_R4),           intent(in)  :: a(:,:,:)     ! input array
      real(ESMF_KIND_R4), optional, intent(in)  :: fac          ! multiplication factor
      real(ESMF_KIND_R4), optional, intent(out) :: pmax, pmin   ! min/max value
!                         ---
      integer im, jt
      im = size(a,1) * size(a,2)
      jt = size(a,3)
      call pmaxmin2d_r4 ( qname, reshape(a,(/ im, jt /)), pmin, pmax, fac )
    end subroutine pmaxmin3d_r4

    subroutine pmaxmin2d_r4 ( qname, a, pmin_, pmax_, fac_ )

      implicit none
      character(len=*),             intent(in)  :: qname        ! label to print
      real(ESMF_KIND_R4),           intent(in)  :: a(:,:)       ! input array
      real(ESMF_KIND_R4), optional, intent(in)  :: fac_         ! multiplication factor
      real(ESMF_KIND_R4), optional, intent(out) :: pmax_, pmin_ ! min/max value
!                                           ---

      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
      integer :: status

      im = size(a,1)
      jt = size(a,2)
      allocate(qmin(jt),qmax(jt))

      if ( present(fac_) ) then
         fac = fac_
      else
         fac = 1.0
      end if

      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

      pm1(1) = pmax
      pm1(2) = -pmin
      call MAPL_CommsAllReduceMax(vm, sendbuf=pm1, recvbuf=pm_res, cnt=two, RC=status)
      pmax=pm_res(1)
      pmin=-pm_res(2)

      if ( present(pmax_) ) pmax_ = pmax
      if ( present(pmin_) ) pmin_ = pmin
      deallocate(qmax,qmin)

      if ( fac /= 0.0 ) then  ! trick to prevent printing
         if ( MAPL_am_I_root() ) then
            name = '            '
            name(1:len(qname)) = qname
            write(*,*) name, ' max = ', pmax*fac, ' min = ', pmin*fac
            return
         end if
      end if

      return

    end subroutine pmaxmin2d_r4

    subroutine pmaxmin1d_r4 ( qname, a, pmin, pmax, fac )
      implicit none
      character(len=*),             intent(in)  :: qname        ! label to print
      real(ESMF_KIND_R4),           intent(in)  :: a(:)         ! input array
      real(ESMF_KIND_R4), optional, intent(in)  :: fac          ! multiplication factor
      real(ESMF_KIND_R4), optional, intent(out) :: pmax, pmin   ! min/max value

      integer :: im, jt
      im = size(a)
      jt = 1
      call pmaxmin2d_r4 ( qname, reshape(a,(/ im, jt /)), pmin, pmax, fac )
    end subroutine pmaxmin1d_r4

!---

  subroutine pmaxmin3d_r8 ( qname, a, pmin, pmax, fac )
      implicit none
      character(len=*),             intent(in)  :: qname        ! label to print
      real(ESMF_KIND_R8),           intent(in)  :: a(:,:,:)     ! input array
      real(ESMF_KIND_R8), optional, intent(in)  :: fac          ! multiplication factor
      real(ESMF_KIND_R8), optional, intent(out) :: pmax, pmin   ! min/max value
!                         ---
      real(ESMF_KIND_R4) :: pmin_r4, pmax_r4, fac_r4
      if ( present(fac) ) then
         fac_r4 = fac
      else
         fac_r4 = 1.0
      end if
      call pmaxmin3d_r4 ( qname, real(a,kind=ESMF_KIND_R4), pmin_r4, pmax_r4, fac_r4 )
      if ( present(pmin) ) pmin = pmin_r4
      if ( present(pmax) ) pmax = pmax_r4
   end subroutine pmaxmin3d_r8

  subroutine pmaxmin2d_r8 ( qname, a, pmin, pmax, fac )
      implicit none
      character(len=*),             intent(in)  :: qname        ! label to print
      real(ESMF_KIND_R8),           intent(in)  :: a(:,:)     ! input array
      real(ESMF_KIND_R8), optional, intent(in)  :: fac          ! multiplication factor
      real(ESMF_KIND_R8), optional, intent(out) :: pmax, pmin   ! min/max value
!                         ---
      real(ESMF_KIND_R4) :: pmin_r4, pmax_r4, fac_r4
      if ( present(fac) ) then
         fac_r4 = fac
      else
         fac_r4 = 1.0
      end if
      call pmaxmin2d_r4 ( qname, real(a,kind=ESMF_KIND_R4), pmin_r4, pmax_r4, fac_r4 )
      if ( present(pmin) ) pmin = pmin_r4
      if ( present(pmax) ) pmax = pmax_r4
   end subroutine pmaxmin2d_r8

  subroutine pmaxmin1d_r8 ( qname, a, pmin, pmax, fac )
      implicit none
      character(len=*),             intent(in)  :: qname        ! label to print
      real(ESMF_KIND_R8),           intent(in)  :: a(:)         ! input array
      real(ESMF_KIND_R8), optional, intent(in)  :: fac          ! multiplication factor
      real(ESMF_KIND_R8), optional, intent(out) :: pmax, pmin   ! min/max value
!                         ---
      real(ESMF_KIND_R4) :: pmin_r4, pmax_r4, fac_r4
      if ( present(fac) ) then
         fac_r4 = fac
      else
         fac_r4 = 1.0
      end if
      call pmaxmin1d_r4 ( qname, real(a,kind=ESMF_KIND_R4), pmin_r4, pmax_r4, fac_r4 )
      if ( present(pmin) ) pmin = pmin_r4
      if ( present(pmax) ) pmax = pmax_r4
   end subroutine pmaxmin1d_r8


 end module MAPL_MaxMinMod