MOM6
Data Types | Functions/Subroutines | Variables
mom_coms Module Reference

Detailed Description

Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums facility.

Data Types

interface  assignment(=)
 Copy the value of one extended-fixed-point number into another. More...
 
interface  efp_sum_across_pes
 Sum a value or 1-d array of values across processors, returning the sums in place. More...
 
type  efp_type
 The Extended Fixed Point (EFP) type provides a public interface for doing sums and taking differences with this type. More...
 
interface  operator(+)
 Add two extended-fixed-point numbers. More...
 
interface  operator(-)
 Subtract one extended-fixed-point number from another. More...
 
interface  reproducing_sum
 Find an accurate and order-invariant sum of a distributed 2d or 3d field. More...
 
interface  reproducing_sum_efp
 Find an accurate and order-invariant sum of a distributed 2d field, returning the result in the form of an extended fixed point value that can be converted back with EFP_to_real. More...
 

Functions/Subroutines

type(efp_type) function reproducing_efp_sum_2d (array, isr, ier, jsr, jer, overflow_check, err, only_on_PE)
 This subroutine uses a conversion to an integer representation of real numbers to give an order-invariant sum of distributed 2-D arrays that reproduces across domain decomposition, with the result returned as an extended fixed point type that can be converted back to a real number using EFP_to_real. This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, doi:10.1016/j.parco.2014.04.007. More...
 
real function reproducing_sum_2d (array, isr, ier, jsr, jer, EFP_sum, reproducing, overflow_check, err, only_on_PE)
 This subroutine uses a conversion to an integer representation of real numbers to give an order-invariant sum of distributed 2-D arrays that reproduces across domain decomposition. This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, doi:10.1016/j.parco.2014.04.007. More...
 
real function reproducing_sum_3d (array, isr, ier, jsr, jer, sums, EFP_sum, EFP_lay_sums, err, only_on_PE)
 This subroutine uses a conversion to an integer representation of real numbers to give an order-invariant sum of distributed 3-D arrays that reproduces across domain decomposition. This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, doi:10.1016/j.parco.2014.04.007. More...
 
integer(kind=8) function, dimension(ni) real_to_ints (r, prec_error, overflow)
 Convert a real number into the array of integers constitute its extended-fixed-point representation. More...
 
real function ints_to_real (ints)
 Convert the array of integers that constitute an extended-fixed-point representation into a real number. More...
 
subroutine increment_ints (int_sum, int2, prec_error)
 Increment an array of integers that constitutes an extended-fixed-point representation with a another EFP number. More...
 
subroutine increment_ints_faster (int_sum, r, max_mag_term)
 Increment an EFP number with a real number without doing any carrying of of overflows and using only minimal error checking. More...
 
subroutine carry_overflow (int_sum, prec_error)
 This subroutine handles carrying of the overflow. More...
 
subroutine regularize_ints (int_sum)
 This subroutine carries the overflow, and then makes sure that all integers are of the same sign as the overall value. More...
 
logical function, public query_efp_overflow_error ()
 Returns the status of the module's error flag.
 
subroutine, public reset_efp_overflow_error ()
 Reset the module's error flag to false.
 
type(efp_type) function, public efp_plus (EFP1, EFP2)
 Add two extended-fixed-point numbers. More...
 
type(efp_type) function, public efp_minus (EFP1, EFP2)
 Subract one extended-fixed-point number from another. More...
 
subroutine efp_assign (EFP1, EFP2)
 Copy one extended-fixed-point number into another. More...
 
real function, public efp_to_real (EFP1)
 Return the real number that an extended-fixed-point number corresponds with. More...
 
real function, public efp_real_diff (EFP1, EFP2)
 Take the difference between two extended-fixed-point numbers (EFP1 - EFP2) and return the result as a real number. More...
 
type(efp_type) function, public real_to_efp (val, overflow)
 Return the extended-fixed-point number that a real number corresponds with. More...
 
subroutine, public efp_list_sum_across_pes (EFPs, nval, errors)
 This subroutine does a sum across PEs of a list of EFP variables, returning the sums in place, with all overflows carried. More...
 
subroutine efp_val_sum_across_pes (EFP, error)
 This subroutine does a sum across PEs of an EFP variable, returning the sums in place, with all overflows carried. More...
 
subroutine, public mom_infra_end
 This subroutine carries out all of the calls required to close out the infrastructure cleanly. This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs.
 

Variables

integer(kind=8), parameter prec =2_8**46
 The precision of each integer.
 
real, parameter r_prec =2.0**46
 A real version of prec.
 
real, parameter i_prec =1.0/(2.0**46)
 The inverse of prec.
 
integer, parameter max_count_prec =2**(63-46)-1
 The number of values that can be added together with the current value of prec before there will be roundoff problems.
 
integer, parameter ni =6
 The number of long integers to use to represent a real number.
 
real, dimension(ni), parameter pr = (/ r_prec**2, r_prec, 1.0, 1.0/r_prec, 1.0/r_prec**2, 1.0/r_prec**3 /)
 An array of the real precision of each of the integers.
 
real, dimension(ni), parameter i_pr = (/ 1.0/r_prec**2, 1.0/r_prec, 1.0, r_prec, r_prec**2, r_prec**3 /)
 An array of the inverse of the real precision of each of the integers.
 
real, parameter max_efp_float = pr(1) * (2.**63 - 1.)
 The largest float with an EFP representation. NOTE: Only the first bin can exceed precision, but is bounded by the largest signed integer.
 
logical overflow_error = .false.
 This becomes true if an overflow is encountered.
 
logical nan_error = .false.
 This becomes true if a NaN is encountered.
 
logical debug = .false.
 Making this true enables debugging output.
 

Function/Subroutine Documentation

◆ carry_overflow()

subroutine mom_coms::carry_overflow ( integer(kind=8), dimension(ni), intent(inout)  int_sum,
integer(kind=8), intent(in)  prec_error 
)
private

This subroutine handles carrying of the overflow.

Parameters
[in,out]int_sumThe array of EFP integers being modified by carries, but without changing value.
[in]prec_errorThe PE-count dependent precision of the integers that is safe from overflows during global sums. This will be larger than the compile-time precision parameter, and is used to detect overflows.

Definition at line 629 of file MOM_coms.F90.

629  integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being
630  !! modified by carries, but without changing value.
631  integer(kind=8), intent(in) :: prec_error !< The PE-count dependent precision of the
632  !! integers that is safe from overflows during global
633  !! sums. This will be larger than the compile-time
634  !! precision parameter, and is used to detect overflows.
635 
636  ! This subroutine handles carrying of the overflow.
637  integer :: i, num_carry
638 
639  do i=ni,2,-1 ; if (abs(int_sum(i)) >= prec) then
640  num_carry = int(int_sum(i) * i_prec)
641  int_sum(i) = int_sum(i) - num_carry*prec
642  int_sum(i-1) = int_sum(i-1) + num_carry
643  endif ; enddo
644  if (abs(int_sum(1)) > prec_error) then
645  overflow_error = .true.
646  endif
647 

◆ efp_assign()

subroutine mom_coms::efp_assign ( type(efp_type), intent(out)  EFP1,
type(efp_type), intent(in)  EFP2 
)
private

Copy one extended-fixed-point number into another.

Parameters
[out]efp1The recipient extended fixed point number
[in]efp2The source extended fixed point number

Definition at line 729 of file MOM_coms.F90.

729  type(EFP_type), intent(out) :: EFP1 !< The recipient extended fixed point number
730  type(EFP_type), intent(in) :: EFP2 !< The source extended fixed point number
731  integer i
732  ! This subroutine assigns all components of the extended fixed point type
733  ! variable on the RHS (EFP2) to the components of the variable on the LHS
734  ! (EFP1).
735 
736  do i=1,ni ; efp1%v(i) = efp2%v(i) ; enddo

◆ efp_list_sum_across_pes()

subroutine, public mom_coms::efp_list_sum_across_pes ( type(efp_type), dimension(:), intent(inout)  EFPs,
integer, intent(in)  nval,
logical, dimension(:), intent(out), optional  errors 
)

This subroutine does a sum across PEs of a list of EFP variables, returning the sums in place, with all overflows carried.

Parameters
[in,out]efpsThe list of extended fixed point numbers
[in]nvalThe number of values being summed.
[out]errorsA list of error flags for each sum

Definition at line 789 of file MOM_coms.F90.

789  type(EFP_type), dimension(:), &
790  intent(inout) :: EFPs !< The list of extended fixed point numbers
791  !! being summed across PEs.
792  integer, intent(in) :: nval !< The number of values being summed.
793  logical, dimension(:), &
794  optional, intent(out) :: errors !< A list of error flags for each sum
795 
796  ! This subroutine does a sum across PEs of a list of EFP variables,
797  ! returning the sums in place, with all overflows carried.
798 
799  integer(kind=8), dimension(ni,nval) :: ints
800  integer(kind=8) :: prec_error
801  logical :: error_found
802  character(len=256) :: mesg
803  integer :: i, n
804 
805  if (num_pes() > max_count_prec) call mom_error(fatal, &
806  "reproducing_sum: Too many processors are being used for the value of "//&
807  "prec. Reduce prec to (2^63-1)/num_PEs.")
808 
809  prec_error = (2_8**62 + (2_8**62 - 1)) / num_pes()
810  ! overflow_error is an overflow error flag for the whole module.
811  overflow_error = .false. ; error_found = .false.
812 
813  do i=1,nval ; do n=1,ni ; ints(n,i) = efps(i)%v(n) ; enddo ; enddo
814 
815  call sum_across_pes(ints(:,:), ni*nval)
816 
817  if (present(errors)) errors(:) = .false.
818  do i=1,nval
819  overflow_error = .false.
820  call carry_overflow(ints(:,i), prec_error)
821  do n=1,ni ; efps(i)%v(n) = ints(n,i) ; enddo
822  if (present(errors)) errors(i) = overflow_error
823  if (overflow_error) then
824  write (mesg,'("EFP_list_sum_across_PEs error at ",i6," val was ",ES12.6, ", prec_error = ",ES12.6)') &
825  i, efp_to_real(efps(i)), real(prec_error)
826  call mom_error(warning, mesg)
827  endif
828  error_found = error_found .or. overflow_error
829  enddo
830  if (error_found .and. .not.(present(errors))) then
831  call mom_error(fatal, "Overflow in EFP_list_sum_across_PEs.")
832  endif
833 

◆ efp_minus()

type(efp_type) function, public mom_coms::efp_minus ( type(efp_type), intent(in)  EFP1,
type(efp_type), intent(in)  EFP2 
)

Subract one extended-fixed-point number from another.

Returns
The result in extended fixed point format
Parameters
[in]efp1The first extended fixed point number
[in]efp2The extended fixed point number being subtracted from the first extended fixed point number

Definition at line 716 of file MOM_coms.F90.

716  type(EFP_type) :: EFP_minus !< The result in extended fixed point format
717  type(EFP_type), intent(in) :: EFP1 !< The first extended fixed point number
718  type(EFP_type), intent(in) :: EFP2 !< The extended fixed point number being
719  !! subtracted from the first extended fixed point number
720  integer :: i
721 
722  do i=1,ni ; efp_minus%v(i) = -1*efp2%v(i) ; enddo
723 
724  call increment_ints(efp_minus%v(:), efp1%v(:))

◆ efp_plus()

type(efp_type) function, public mom_coms::efp_plus ( type(efp_type), intent(in)  EFP1,
type(efp_type), intent(in)  EFP2 
)

Add two extended-fixed-point numbers.

Returns
The result in extended fixed point format
Parameters
[in]efp1The first extended fixed point number
[in]efp2The second extended fixed point number

Definition at line 705 of file MOM_coms.F90.

705  type(EFP_type) :: EFP_plus !< The result in extended fixed point format
706  type(EFP_type), intent(in) :: EFP1 !< The first extended fixed point number
707  type(EFP_type), intent(in) :: EFP2 !< The second extended fixed point number
708 
709  efp_plus = efp1
710 
711  call increment_ints(efp_plus%v(:), efp2%v(:))

◆ efp_real_diff()

real function, public mom_coms::efp_real_diff ( type(efp_type), intent(in)  EFP1,
type(efp_type), intent(in)  EFP2 
)

Take the difference between two extended-fixed-point numbers (EFP1 - EFP2) and return the result as a real number.

Parameters
[in]efp1The first extended fixed point number
[in]efp2The extended fixed point number being subtracted from the first extended fixed point number
Returns
The real result

Definition at line 751 of file MOM_coms.F90.

751  type(EFP_type), intent(in) :: EFP1 !< The first extended fixed point number
752  type(EFP_type), intent(in) :: EFP2 !< The extended fixed point number being
753  !! subtracted from the first extended fixed point number
754  real :: EFP_real_diff !< The real result
755 
756  type(EFP_type) :: EFP_diff
757 
758  efp_diff = efp1 - efp2
759  efp_real_diff = efp_to_real(efp_diff)
760 

◆ efp_to_real()

real function, public mom_coms::efp_to_real ( type(efp_type), intent(inout)  EFP1)

Return the real number that an extended-fixed-point number corresponds with.

Parameters
[in,out]efp1The extended fixed point number being converted

Definition at line 741 of file MOM_coms.F90.

741  type(EFP_type), intent(inout) :: EFP1 !< The extended fixed point number being converted
742  real :: EFP_to_real
743 
744  call regularize_ints(efp1%v)
745  efp_to_real = ints_to_real(efp1%v)

◆ efp_val_sum_across_pes()

subroutine mom_coms::efp_val_sum_across_pes ( type(efp_type), intent(inout)  EFP,
logical, intent(out), optional  error 
)
private

This subroutine does a sum across PEs of an EFP variable, returning the sums in place, with all overflows carried.

Parameters
[in,out]efpThe extended fixed point numbers being summed across PEs.
[out]errorAn error flag for this sum

Definition at line 839 of file MOM_coms.F90.

839  type(EFP_type), intent(inout) :: EFP !< The extended fixed point numbers
840  !! being summed across PEs.
841  logical, optional, intent(out) :: error !< An error flag for this sum
842 
843  ! This subroutine does a sum across PEs of a list of EFP variables,
844  ! returning the sums in place, with all overflows carried.
845 
846  integer(kind=8), dimension(ni) :: ints
847  integer(kind=8) :: prec_error
848  logical :: error_found
849  character(len=256) :: mesg
850  integer :: n
851 
852  if (num_pes() > max_count_prec) call mom_error(fatal, &
853  "reproducing_sum: Too many processors are being used for the value of "//&
854  "prec. Reduce prec to (2^63-1)/num_PEs.")
855 
856  prec_error = (2_8**62 + (2_8**62 - 1)) / num_pes()
857  ! overflow_error is an overflow error flag for the whole module.
858  overflow_error = .false. ; error_found = .false.
859 
860  do n=1,ni ; ints(n) = efp%v(n) ; enddo
861 
862  call sum_across_pes(ints(:), ni)
863 
864  if (present(error)) error = .false.
865 
866  overflow_error = .false.
867  call carry_overflow(ints(:), prec_error)
868  do n=1,ni ; efp%v(n) = ints(n) ; enddo
869  if (present(error)) error = overflow_error
870  if (overflow_error) then
871  write (mesg,'("EFP_val_sum_across_PEs error val was ",ES12.6, ", prec_error = ",ES12.6)') &
872  efp_to_real(efp), real(prec_error)
873  call mom_error(warning, mesg)
874  endif
875  error_found = error_found .or. overflow_error
876 
877  if (error_found .and. .not.(present(error))) then
878  call mom_error(fatal, "Overflow in EFP_val_sum_across_PEs.")
879  endif
880 

◆ increment_ints()

subroutine mom_coms::increment_ints ( integer(kind=8), dimension(ni), intent(inout)  int_sum,
integer(kind=8), dimension(ni), intent(in)  int2,
integer(kind=8), intent(in), optional  prec_error 
)
private

Increment an array of integers that constitutes an extended-fixed-point representation with a another EFP number.

Parameters
[in,out]int_sumThe array of EFP integers being incremented
[in]int2The array of EFP integers being added
[in]prec_errorThe PE-count dependent precision of the integers that is safe from overflows during global sums. This will be larger than the compile-time precision parameter, and is used to detect overflows.

Definition at line 563 of file MOM_coms.F90.

563  integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being incremented
564  integer(kind=8), dimension(ni), intent(in) :: int2 !< The array of EFP integers being added
565  integer(kind=8), optional, intent(in) :: prec_error !< The PE-count dependent precision of the
566  !! integers that is safe from overflows during global
567  !! sums. This will be larger than the compile-time
568  !! precision parameter, and is used to detect overflows.
569 
570  ! This subroutine increments a number with another, both using the integer
571  ! representation in real_to_ints.
572  integer :: i
573 
574  do i=ni,2,-1
575  int_sum(i) = int_sum(i) + int2(i)
576  ! Carry the local overflow.
577  if (int_sum(i) > prec) then
578  int_sum(i) = int_sum(i) - prec
579  int_sum(i-1) = int_sum(i-1) + 1
580  elseif (int_sum(i) < -prec) then
581  int_sum(i) = int_sum(i) + prec
582  int_sum(i-1) = int_sum(i-1) - 1
583  endif
584  enddo
585  int_sum(1) = int_sum(1) + int2(1)
586  if (present(prec_error)) then
587  if (abs(int_sum(1)) > prec_error) overflow_error = .true.
588  else
589  if (abs(int_sum(1)) > prec) overflow_error = .true.
590  endif
591 

◆ increment_ints_faster()

subroutine mom_coms::increment_ints_faster ( integer(kind=8), dimension(ni), intent(inout)  int_sum,
real, intent(in)  r,
real, intent(inout)  max_mag_term 
)
private

Increment an EFP number with a real number without doing any carrying of of overflows and using only minimal error checking.

Parameters
[in,out]int_sumThe array of EFP integers being incremented
[in]rThe real number being added.
[in,out]max_mag_termA running maximum magnitude of the r's.

Definition at line 597 of file MOM_coms.F90.

597  integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being incremented
598  real, intent(in) :: r !< The real number being added.
599  real, intent(inout) :: max_mag_term !< A running maximum magnitude of the r's.
600 
601  ! This subroutine increments a number with another, both using the integer
602  ! representation in real_to_ints, but without doing any carrying of overflow.
603  ! The entire operation is embedded in a single call for greater speed.
604  real :: rs
605  integer(kind=8) :: ival
606  integer :: sgn, i
607 
608  if ((r >= 1e30) .eqv. (r < 1e30)) then ; nan_error = .true. ; return ; endif
609  sgn = 1 ; if (r<0.0) sgn = -1
610  rs = abs(r)
611  if (rs > abs(max_mag_term)) max_mag_term = r
612 
613  ! Abort if the number has no EFP representation
614  if (rs > max_efp_float) then
615  overflow_error = .true.
616  return
617  endif
618 
619  do i=1,ni
620  ival = int(rs*i_pr(i), 8)
621  rs = rs - ival*pr(i)
622  int_sum(i) = int_sum(i) + sgn*ival
623  enddo
624 

◆ ints_to_real()

real function mom_coms::ints_to_real ( integer(kind=8), dimension(ni), intent(in)  ints)
private

Convert the array of integers that constitute an extended-fixed-point representation into a real number.

Parameters
[in]intsThe array of EFP integers

Definition at line 550 of file MOM_coms.F90.

550  integer(kind=8), dimension(ni), intent(in) :: ints !< The array of EFP integers
551  real :: r
552  ! This subroutine reverses the conversion in real_to_ints.
553 
554  integer :: i
555 
556  r = 0.0
557  do i=1,ni ; r = r + pr(i)*ints(i) ; enddo

◆ real_to_efp()

type(efp_type) function, public mom_coms::real_to_efp ( real, intent(in)  val,
logical, intent(inout), optional  overflow 
)

Return the extended-fixed-point number that a real number corresponds with.

Parameters
[in]valThe real number being converted
[in,out]overflowReturns true if the conversion is being done on a value that is too large to be represented

Definition at line 765 of file MOM_coms.F90.

765  real, intent(in) :: val !< The real number being converted
766  logical, optional, intent(inout) :: overflow !< Returns true if the conversion is being
767  !! done on a value that is too large to be represented
768  type(EFP_type) :: real_to_EFP
769 
770  logical :: over
771  character(len=80) :: mesg
772 
773  if (present(overflow)) then
774  real_to_efp%v(:) = real_to_ints(val, overflow=overflow)
775  else
776  over = .false.
777  real_to_efp%v(:) = real_to_ints(val, overflow=over)
778  if (over) then
779  write(mesg, '(ES13.5)') val
780  call mom_error(fatal,"Overflow in real_to_EFP conversion of "//trim(mesg))
781  endif
782  endif
783 

◆ real_to_ints()

integer(kind=8) function, dimension(ni) mom_coms::real_to_ints ( real, intent(in)  r,
integer(kind=8), intent(in), optional  prec_error,
logical, intent(inout), optional  overflow 
)
private

Convert a real number into the array of integers constitute its extended-fixed-point representation.

Parameters
[in]rThe real number being converted
[in]prec_errorThe PE-count dependent precision of the integers that is safe from overflows during global sums. This will be larger than the compile-time precision parameter, and is used to detect overflows.
[in,out]overflowReturns true if the conversion is being done on a value that is too large to be represented

Definition at line 508 of file MOM_coms.F90.

508  real, intent(in) :: r !< The real number being converted
509  integer(kind=8), optional, intent(in) :: prec_error !< The PE-count dependent precision of the
510  !! integers that is safe from overflows during global
511  !! sums. This will be larger than the compile-time
512  !! precision parameter, and is used to detect overflows.
513  logical, optional, intent(inout) :: overflow !< Returns true if the conversion is being
514  !! done on a value that is too large to be represented
515  integer(kind=8), dimension(ni) :: ints
516  ! This subroutine converts a real number to an equivalent representation
517  ! using several long integers.
518 
519  real :: rs
520  character(len=80) :: mesg
521  integer(kind=8) :: ival, prec_err
522  integer :: sgn, i
523 
524  prec_err = prec ; if (present(prec_error)) prec_err = prec_error
525  ints(:) = 0_8
526  if ((r >= 1e30) .eqv. (r < 1e30)) then ; nan_error = .true. ; return ; endif
527 
528  sgn = 1 ; if (r<0.0) sgn = -1
529  rs = abs(r)
530 
531  if (present(overflow)) then
532  if (.not.(rs < prec_err*pr(1))) overflow = .true.
533  if ((r >= 1e30) .eqv. (r < 1e30)) overflow = .true.
534  elseif (.not.(rs < prec_err*pr(1))) then
535  write(mesg, '(ES13.5)') r
536  call mom_error(fatal,"Overflow in real_to_ints conversion of "//trim(mesg))
537  endif
538 
539  do i=1,ni
540  ival = int(rs*i_pr(i), 8)
541  rs = rs - ival*pr(i)
542  ints(i) = sgn*ival
543  enddo
544 

◆ regularize_ints()

subroutine mom_coms::regularize_ints ( integer(kind=8), dimension(ni), intent(inout)  int_sum)
private

This subroutine carries the overflow, and then makes sure that all integers are of the same sign as the overall value.

Parameters
[in,out]int_sumThe array of integers being modified to take a

Definition at line 653 of file MOM_coms.F90.

653  integer(kind=8), dimension(ni), &
654  intent(inout) :: int_sum !< The array of integers being modified to take a
655  !! regular form with all integers of the same sign,
656  !! but without changing value.
657 
658  ! This subroutine carries the overflow, and then makes sure that
659  ! all integers are of the same sign as the overall value.
660  logical :: positive
661  integer :: i, num_carry
662 
663  do i=ni,2,-1 ; if (abs(int_sum(i)) >= prec) then
664  num_carry = int(int_sum(i) * i_prec)
665  int_sum(i) = int_sum(i) - num_carry*prec
666  int_sum(i-1) = int_sum(i-1) + num_carry
667  endif ; enddo
668 
669  ! Determine the sign of the final number.
670  positive = .true.
671  do i=1,ni
672  if (abs(int_sum(i)) > 0) then
673  if (int_sum(i) < 0) positive = .false.
674  exit
675  endif
676  enddo
677 
678  if (positive) then
679  do i=ni,2,-1 ; if (int_sum(i) < 0) then
680  int_sum(i) = int_sum(i) + prec
681  int_sum(i-1) = int_sum(i-1) - 1
682  endif ; enddo
683  else
684  do i=ni,2,-1 ; if (int_sum(i) > 0) then
685  int_sum(i) = int_sum(i) - prec
686  int_sum(i-1) = int_sum(i-1) + 1
687  endif ; enddo
688  endif
689 

◆ reproducing_efp_sum_2d()

type(efp_type) function mom_coms::reproducing_efp_sum_2d ( real, dimension(:,:), intent(in)  array,
integer, intent(in), optional  isr,
integer, intent(in), optional  ier,
integer, intent(in), optional  jsr,
integer, intent(in), optional  jer,
logical, intent(in), optional  overflow_check,
integer, intent(out), optional  err,
logical, intent(in), optional  only_on_PE 
)
private

This subroutine uses a conversion to an integer representation of real numbers to give an order-invariant sum of distributed 2-D arrays that reproduces across domain decomposition, with the result returned as an extended fixed point type that can be converted back to a real number using EFP_to_real. This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, doi:10.1016/j.parco.2014.04.007.

Parameters
[in]arrayThe array to be summed
[in]isrThe starting i-index of the sum, noting that the array indices starts at 1
[in]ierThe ending i-index of the sum, noting that the array indices starts at 1
[in]jsrThe starting j-index of the sum, noting that the array indices starts at 1
[in]jerThe ending j-index of the sum, noting that the array indices starts at 1
[in]overflow_checkIf present and false, disable checking for overflows in incremental results. This can speed up calculations if the number of values being summed is small enough
[out]errIf present, return an error code instead of triggering any fatal errors directly from this routine.
[in]only_on_peIf present and true, do not do the sum across processors, only reporting the local sum
Returns
The result in extended fixed point format

Definition at line 93 of file MOM_coms.F90.

93  real, dimension(:,:), intent(in) :: array !< The array to be summed
94  integer, optional, intent(in) :: isr !< The starting i-index of the sum, noting
95  !! that the array indices starts at 1
96  integer, optional, intent(in) :: ier !< The ending i-index of the sum, noting
97  !! that the array indices starts at 1
98  integer, optional, intent(in) :: jsr !< The starting j-index of the sum, noting
99  !! that the array indices starts at 1
100  integer, optional, intent(in) :: jer !< The ending j-index of the sum, noting
101  !! that the array indices starts at 1
102  logical, optional, intent(in) :: overflow_check !< If present and false, disable
103  !! checking for overflows in incremental results.
104  !! This can speed up calculations if the number
105  !! of values being summed is small enough
106  integer, optional, intent(out) :: err !< If present, return an error code instead of
107  !! triggering any fatal errors directly from
108  !! this routine.
109  logical, optional, intent(in) :: only_on_PE !< If present and true, do not do the sum
110  !! across processors, only reporting the local sum
111  type(EFP_type) :: EFP_sum !< The result in extended fixed point format
112 
113  ! This subroutine uses a conversion to an integer representation
114  ! of real numbers to give order-invariant sums that will reproduce
115  ! across PE count. This idea comes from R. Hallberg and A. Adcroft.
116 
117  integer(kind=8), dimension(ni) :: ints_sum
118  integer(kind=8) :: ival, prec_error
119  real :: rs
120  real :: max_mag_term
121  logical :: over_check, do_sum_across_PEs
122  character(len=256) :: mesg
123  integer :: i, j, n, is, ie, js, je, sgn
124 
125  if (num_pes() > max_count_prec) call mom_error(fatal, &
126  "reproducing_sum: Too many processors are being used for the value of "//&
127  "prec. Reduce prec to (2^63-1)/num_PEs.")
128 
129  prec_error = (2_8**62 + (2_8**62 - 1)) / num_pes()
130 
131  is = 1 ; ie = size(array,1) ; js = 1 ; je = size(array,2 )
132  if (present(isr)) then
133  if (isr < is) call mom_error(fatal, "Value of isr too small in reproducing_EFP_sum_2d.")
134  is = isr
135  endif
136  if (present(ier)) then
137  if (ier > ie) call mom_error(fatal, "Value of ier too large in reproducing_EFP_sum_2d.")
138  ie = ier
139  endif
140  if (present(jsr)) then
141  if (jsr < js) call mom_error(fatal, "Value of jsr too small in reproducing_EFP_sum_2d.")
142  js = jsr
143  endif
144  if (present(jer)) then
145  if (jer > je) call mom_error(fatal, "Value of jer too large in reproducing_EFP_sum_2d.")
146  je = jer
147  endif
148 
149  over_check = .true. ; if (present(overflow_check)) over_check = overflow_check
150  do_sum_across_pes = .true. ; if (present(only_on_pe)) do_sum_across_pes = .not.only_on_pe
151 
152  overflow_error = .false. ; nan_error = .false. ; max_mag_term = 0.0
153  ints_sum(:) = 0
154  if (over_check) then
155  if ((je+1-js)*(ie+1-is) < max_count_prec) then
156  do j=js,je ; do i=is,ie
157  call increment_ints_faster(ints_sum, array(i,j), max_mag_term)
158  enddo ; enddo
159  call carry_overflow(ints_sum, prec_error)
160  elseif ((ie+1-is) < max_count_prec) then
161  do j=js,je
162  do i=is,ie
163  call increment_ints_faster(ints_sum, array(i,j), max_mag_term)
164  enddo
165  call carry_overflow(ints_sum, prec_error)
166  enddo
167  else
168  do j=js,je ; do i=is,ie
169  call increment_ints(ints_sum, real_to_ints(array(i,j), prec_error), &
170  prec_error)
171  enddo ; enddo
172  endif
173  else
174  do j=js,je ; do i=is,ie
175  sgn = 1 ; if (array(i,j)<0.0) sgn = -1
176  rs = abs(array(i,j))
177  do n=1,ni
178  ival = int(rs*i_pr(n), 8)
179  rs = rs - ival*pr(n)
180  ints_sum(n) = ints_sum(n) + sgn*ival
181  enddo
182  enddo ; enddo
183  call carry_overflow(ints_sum, prec_error)
184  endif
185 
186  if (present(err)) then
187  err = 0
188  if (overflow_error) &
189  err = err+2
190  if (nan_error) &
191  err = err+4
192  if (err > 0) then ; do n=1,ni ; ints_sum(n) = 0 ; enddo ; endif
193  else
194  if (nan_error) then
195  call mom_error(fatal, "NaN in input field of reproducing_EFP_sum(_2d).")
196  endif
197  if (abs(max_mag_term) >= prec_error*pr(1)) then
198  write(mesg, '(ES13.5)') max_mag_term
199  call mom_error(fatal,"Overflow in reproducing_EFP_sum(_2d) conversion of "//trim(mesg))
200  endif
201  if (overflow_error) then
202  call mom_error(fatal, "Overflow in reproducing_EFP_sum(_2d).")
203  endif
204  endif
205 
206  if (do_sum_across_pes) call sum_across_pes(ints_sum, ni)
207 
208  call regularize_ints(ints_sum)
209 
210  efp_sum%v(:) = ints_sum(:)
211 

◆ reproducing_sum_2d()

real function mom_coms::reproducing_sum_2d ( real, dimension(:,:), intent(in)  array,
integer, intent(in), optional  isr,
integer, intent(in), optional  ier,
integer, intent(in), optional  jsr,
integer, intent(in), optional  jer,
type(efp_type), intent(out), optional  EFP_sum,
logical, intent(in), optional  reproducing,
logical, intent(in), optional  overflow_check,
integer, intent(out), optional  err,
logical, intent(in), optional  only_on_PE 
)
private

This subroutine uses a conversion to an integer representation of real numbers to give an order-invariant sum of distributed 2-D arrays that reproduces across domain decomposition. This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, doi:10.1016/j.parco.2014.04.007.

Parameters
[in]arrayThe array to be summed
[in]isrThe starting i-index of the sum, noting that the array indices starts at 1
[in]ierThe ending i-index of the sum, noting that the array indices starts at 1
[in]jsrThe starting j-index of the sum, noting that the array indices starts at 1
[in]jerThe ending j-index of the sum, noting that the array indices starts at 1
[out]efp_sumThe result in extended fixed point format
[in]reproducingIf present and false, do the sum using the naive non-reproducing approach
[in]overflow_checkIf present and false, disable checking for overflows in incremental results. This can speed up calculations if the number of values being summed is small enough
[out]errIf present, return an error code instead of triggering any fatal errors directly from this routine.
[in]only_on_peIf present and true, do not do the sum across processors, only reporting the local sum
Returns
Result

Definition at line 220 of file MOM_coms.F90.

220  real, dimension(:,:), intent(in) :: array !< The array to be summed
221  integer, optional, intent(in) :: isr !< The starting i-index of the sum, noting
222  !! that the array indices starts at 1
223  integer, optional, intent(in) :: ier !< The ending i-index of the sum, noting
224  !! that the array indices starts at 1
225  integer, optional, intent(in) :: jsr !< The starting j-index of the sum, noting
226  !! that the array indices starts at 1
227  integer, optional, intent(in) :: jer !< The ending j-index of the sum, noting
228  !! that the array indices starts at 1
229  type(EFP_type), optional, intent(out) :: EFP_sum !< The result in extended fixed point format
230  logical, optional, intent(in) :: reproducing !< If present and false, do the sum
231  !! using the naive non-reproducing approach
232  logical, optional, intent(in) :: overflow_check !< If present and false, disable
233  !! checking for overflows in incremental results.
234  !! This can speed up calculations if the number
235  !! of values being summed is small enough
236  integer, optional, intent(out) :: err !< If present, return an error code instead of
237  !! triggering any fatal errors directly from
238  !! this routine.
239  logical, optional, intent(in) :: only_on_PE !< If present and true, do not do the sum
240  !! across processors, only reporting the local sum
241  real :: sum !< Result
242 
243  ! This subroutine uses a conversion to an integer representation
244  ! of real numbers to give order-invariant sums that will reproduce
245  ! across PE count. This idea comes from R. Hallberg and A. Adcroft.
246 
247  integer(kind=8), dimension(ni) :: ints_sum
248  integer(kind=8) :: prec_error
249  real :: rsum(1), rs
250  logical :: repro, do_sum_across_PEs
251  character(len=256) :: mesg
252  type(EFP_type) :: EFP_val ! An extended fixed point version of the sum
253  integer :: i, j, n, is, ie, js, je
254 
255  if (num_pes() > max_count_prec) call mom_error(fatal, &
256  "reproducing_sum: Too many processors are being used for the value of "//&
257  "prec. Reduce prec to (2^63-1)/num_PEs.")
258 
259  prec_error = (2_8**62 + (2_8**62 - 1)) / num_pes()
260 
261  is = 1 ; ie = size(array,1) ; js = 1 ; je = size(array,2 )
262  if (present(isr)) then
263  if (isr < is) call mom_error(fatal, "Value of isr too small in reproducing_sum_2d.")
264  is = isr
265  endif
266  if (present(ier)) then
267  if (ier > ie) call mom_error(fatal, "Value of ier too large in reproducing_sum_2d.")
268  ie = ier
269  endif
270  if (present(jsr)) then
271  if (jsr < js) call mom_error(fatal, "Value of jsr too small in reproducing_sum_2d.")
272  js = jsr
273  endif
274  if (present(jer)) then
275  if (jer > je) call mom_error(fatal, "Value of jer too large in reproducing_sum_2d.")
276  je = jer
277  endif
278 
279  repro = .true. ; if (present(reproducing)) repro = reproducing
280  do_sum_across_pes = .true. ; if (present(only_on_pe)) do_sum_across_pes = .not.only_on_pe
281 
282  if (repro) then
283  efp_val = reproducing_efp_sum_2d(array, isr, ier, jsr, jer, overflow_check, err, only_on_pe)
284  sum = ints_to_real(efp_val%v)
285  if (present(efp_sum)) efp_sum = efp_val
286  if (debug) ints_sum(:) = efp_sum%v(:)
287  else
288  rsum(1) = 0.0
289  do j=js,je ; do i=is,ie
290  rsum(1) = rsum(1) + array(i,j)
291  enddo ; enddo
292  if (do_sum_across_pes) call sum_across_pes(rsum,1)
293  sum = rsum(1)
294 
295  if (present(err)) then ; err = 0 ; endif
296 
297  if (debug .or. present(efp_sum)) then
298  overflow_error = .false.
299  ints_sum = real_to_ints(sum, prec_error, overflow_error)
300  if (overflow_error) then
301  if (present(err)) then
302  err = err + 2
303  else
304  write(mesg, '(ES13.5)') sum
305  call mom_error(fatal,"Repro_sum_2d: Overflow in real_to_ints conversion of "//trim(mesg))
306  endif
307  endif
308  endif
309  if (present(efp_sum)) efp_sum%v(:) = ints_sum(:)
310  endif
311 
312  if (debug) then
313  write(mesg,'("2d RS: ", ES24.16, 6 Z17.16)') sum, ints_sum(1:ni)
314  call mom_mesg(mesg, 3)
315  endif
316 

◆ reproducing_sum_3d()

real function mom_coms::reproducing_sum_3d ( real, dimension(:,:,:), intent(in)  array,
integer, intent(in), optional  isr,
integer, intent(in), optional  ier,
integer, intent(in), optional  jsr,
integer, intent(in), optional  jer,
real, dimension(:), intent(out), optional  sums,
type(efp_type), intent(out), optional  EFP_sum,
type(efp_type), dimension(:), intent(out), optional  EFP_lay_sums,
integer, intent(out), optional  err,
logical, intent(in), optional  only_on_PE 
)
private

This subroutine uses a conversion to an integer representation of real numbers to give an order-invariant sum of distributed 3-D arrays that reproduces across domain decomposition. This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, doi:10.1016/j.parco.2014.04.007.

Parameters
[in]arrayThe array to be summed
[in]isrThe starting i-index of the sum, noting that the array indices starts at 1
[in]ierThe ending i-index of the sum, noting that the array indices starts at 1
[in]jsrThe starting j-index of the sum, noting that the array indices starts at 1
[in]jerThe ending j-index of the sum, noting that the array indices starts at 1
[out]sumsThe sums by vertical layer
[out]efp_sumThe result in extended fixed point format
[out]efp_lay_sumsThe sums by vertical layer in EFP format
[out]errIf present, return an error code instead of triggering any fatal errors directly from this routine.
[in]only_on_peIf present and true, do not do the sum across processors, only reporting the local sum
Returns
Result

Definition at line 325 of file MOM_coms.F90.

325  real, dimension(:,:,:), intent(in) :: array !< The array to be summed
326  integer, optional, intent(in) :: isr !< The starting i-index of the sum, noting
327  !! that the array indices starts at 1
328  integer, optional, intent(in) :: ier !< The ending i-index of the sum, noting
329  !! that the array indices starts at 1
330  integer, optional, intent(in) :: jsr !< The starting j-index of the sum, noting
331  !! that the array indices starts at 1
332  integer, optional, intent(in) :: jer !< The ending j-index of the sum, noting
333  !! that the array indices starts at 1
334  real, dimension(:), optional, intent(out) :: sums !< The sums by vertical layer
335  type(EFP_type), optional, intent(out) :: EFP_sum !< The result in extended fixed point format
336  type(EFP_type), dimension(:), &
337  optional, intent(out) :: EFP_lay_sums !< The sums by vertical layer in EFP format
338  integer, optional, intent(out) :: err !< If present, return an error code instead of
339  !! triggering any fatal errors directly from
340  !! this routine.
341  logical, optional, intent(in) :: only_on_PE !< If present and true, do not do the sum
342  !! across processors, only reporting the local sum
343  real :: sum !< Result
344 
345  ! This subroutine uses a conversion to an integer representation
346  ! of real numbers to give order-invariant sums that will reproduce
347  ! across PE count. This idea comes from R. Hallberg and A. Adcroft.
348 
349  real :: val, max_mag_term
350  integer(kind=8), dimension(ni) :: ints_sum
351  integer(kind=8), dimension(ni,size(array,3)) :: ints_sums
352  integer(kind=8) :: prec_error
353  character(len=256) :: mesg
354  logical :: do_sum_across_PEs
355  integer :: i, j, k, is, ie, js, je, ke, isz, jsz, n
356 
357  if (num_pes() > max_count_prec) call mom_error(fatal, &
358  "reproducing_sum: Too many processors are being used for the value of "//&
359  "prec. Reduce prec to (2^63-1)/num_PEs.")
360 
361  prec_error = (2_8**62 + (2_8**62 - 1)) / num_pes()
362  max_mag_term = 0.0
363 
364  is = 1 ; ie = size(array,1) ; js = 1 ; je = size(array,2) ; ke = size(array,3)
365  if (present(isr)) then
366  if (isr < is) call mom_error(fatal, "Value of isr too small in reproducing_sum(_3d).")
367  is = isr
368  endif
369  if (present(ier)) then
370  if (ier > ie) call mom_error(fatal, "Value of ier too large in reproducing_sum(_3d).")
371  ie = ier
372  endif
373  if (present(jsr)) then
374  if (jsr < js) call mom_error(fatal, "Value of jsr too small in reproducing_sum(_3d).")
375  js = jsr
376  endif
377  if (present(jer)) then
378  if (jer > je) call mom_error(fatal, "Value of jer too large in reproducing_sum(_3d).")
379  je = jer
380  endif
381  jsz = je+1-js; isz = ie+1-is
382 
383  do_sum_across_pes = .true. ; if (present(only_on_pe)) do_sum_across_pes = .not.only_on_pe
384 
385  if (present(sums) .or. present(efp_lay_sums)) then
386  if (present(sums)) then ; if (size(sums) < ke) then
387  call mom_error(fatal, "Sums is smaller than the vertical extent of array in reproducing_sum(_3d).")
388  endif ; endif
389  if (present(efp_lay_sums)) then ; if (size(efp_lay_sums) < ke) then
390  call mom_error(fatal, "Sums is smaller than the vertical extent of array in reproducing_sum(_3d).")
391  endif ; endif
392  ints_sums(:,:) = 0
393  overflow_error = .false. ; nan_error = .false. ; max_mag_term = 0.0
394  if (jsz*isz < max_count_prec) then
395  do k=1,ke
396  do j=js,je ; do i=is,ie
397  call increment_ints_faster(ints_sums(:,k), array(i,j,k), max_mag_term)
398  enddo ; enddo
399  call carry_overflow(ints_sums(:,k), prec_error)
400  enddo
401  elseif (isz < max_count_prec) then
402  do k=1,ke ; do j=js,je
403  do i=is,ie
404  call increment_ints_faster(ints_sums(:,k), array(i,j,k), max_mag_term)
405  enddo
406  call carry_overflow(ints_sums(:,k), prec_error)
407  enddo ; enddo
408  else
409  do k=1,ke ; do j=js,je ; do i=is,ie
410  call increment_ints(ints_sums(:,k), &
411  real_to_ints(array(i,j,k), prec_error), prec_error)
412  enddo ; enddo ; enddo
413  endif
414  if (present(err)) then
415  err = 0
416  if (abs(max_mag_term) >= prec_error*pr(1)) err = err+1
417  if (overflow_error) err = err+2
418  if (nan_error) err = err+2
419  if (err > 0) then ; do k=1,ke ; do n=1,ni ; ints_sums(n,k) = 0 ; enddo ; enddo ; endif
420  else
421  if (nan_error) call mom_error(fatal, "NaN in input field of reproducing_sum(_3d).")
422  if (abs(max_mag_term) >= prec_error*pr(1)) then
423  write(mesg, '(ES13.5)') max_mag_term
424  call mom_error(fatal,"Overflow in reproducing_sum(_3d) conversion of "//trim(mesg))
425  endif
426  if (overflow_error) call mom_error(fatal, "Overflow in reproducing_sum(_3d).")
427  endif
428 
429  if (do_sum_across_pes) call sum_across_pes(ints_sums(:,1:ke), ni*ke)
430 
431  sum = 0.0
432  do k=1,ke
433  call regularize_ints(ints_sums(:,k))
434  val = ints_to_real(ints_sums(:,k))
435  if (present(sums)) sums(k) = val
436  sum = sum + val
437  enddo
438  if (present(efp_lay_sums)) then ; do k=1,ke
439  efp_lay_sums(k)%v(:) = ints_sums(:,k)
440  enddo ; endif
441 
442  if (present(efp_sum)) then
443  efp_sum%v(:) = 0
444  do k=1,ke ; call increment_ints(efp_sum%v(:), ints_sums(:,k)) ; enddo
445  endif
446 
447  if (debug) then
448  do n=1,ni ; ints_sum(n) = 0 ; enddo
449  do k=1,ke ; do n=1,ni ; ints_sum(n) = ints_sum(n) + ints_sums(n,k) ; enddo ; enddo
450  write(mesg,'("3D RS: ", ES24.16, 6 Z17.16)') sum, ints_sum(1:ni)
451  call mom_mesg(mesg, 3)
452  endif
453  else
454  ints_sum(:) = 0
455  overflow_error = .false. ; nan_error = .false. ; max_mag_term = 0.0
456  if (jsz*isz < max_count_prec) then
457  do k=1,ke
458  do j=js,je ; do i=is,ie
459  call increment_ints_faster(ints_sum, array(i,j,k), max_mag_term)
460  enddo ; enddo
461  call carry_overflow(ints_sum, prec_error)
462  enddo
463  elseif (isz < max_count_prec) then
464  do k=1,ke ; do j=js,je
465  do i=is,ie
466  call increment_ints_faster(ints_sum, array(i,j,k), max_mag_term)
467  enddo
468  call carry_overflow(ints_sum, prec_error)
469  enddo ; enddo
470  else
471  do k=1,ke ; do j=js,je ; do i=is,ie
472  call increment_ints(ints_sum, real_to_ints(array(i,j,k), prec_error), &
473  prec_error)
474  enddo ; enddo ; enddo
475  endif
476  if (present(err)) then
477  err = 0
478  if (abs(max_mag_term) >= prec_error*pr(1)) err = err+1
479  if (overflow_error) err = err+2
480  if (nan_error) err = err+2
481  if (err > 0) then ; do n=1,ni ; ints_sum(n) = 0 ; enddo ; endif
482  else
483  if (nan_error) call mom_error(fatal, "NaN in input field of reproducing_sum(_3d).")
484  if (abs(max_mag_term) >= prec_error*pr(1)) then
485  write(mesg, '(ES13.5)') max_mag_term
486  call mom_error(fatal,"Overflow in reproducing_sum(_3d) conversion of "//trim(mesg))
487  endif
488  if (overflow_error) call mom_error(fatal, "Overflow in reproducing_sum(_3d).")
489  endif
490 
491  if (do_sum_across_pes) call sum_across_pes(ints_sum, ni)
492 
493  call regularize_ints(ints_sum)
494  sum = ints_to_real(ints_sum)
495 
496  if (present(efp_sum)) efp_sum%v(:) = ints_sum(:)
497 
498  if (debug) then
499  write(mesg,'("3d RS: ", ES24.16, 6 Z17.16)') sum, ints_sum(1:ni)
500  call mom_mesg(mesg, 3)
501  endif
502  endif
503