eesupp/src/different_multiple.F

C     $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/different_multiple.F,v 1.3 1999/05/24 14:57:55 adcroft Exp $
C $Name: $
#include "CPP_EEOPTIONS.h"

CStartofinterface
      LOGICAL FUNCTION DIFFERENT_MULTIPLE( freq, val1, val2 )
C     /==========================================================\
C     | LOGICAL FUNCTION DIFFERENT_MULTIPLE                      |
C     | o Checks two numbers multiple of a third number.         |
C     |==========================================================|
C     | This routine is used for diagnostic and other periodic   |
C     | operations. It is very sensitive to arithmetic precision.|
C     | For IEEE conforming arithmetic is works well but for     |
C     | cases where short cut arithmetic  is used it may not work|
C     | as expected. To overcome this issue compile this routine |
C     | separately with no optimisation.                         |
C     \==========================================================/
      IMPLICIT NONE
C     Returns TRUE if val1 and val2 are different multiples of freq.
      _RL  freq, val1, val2
CEndofinterface
      _RL  f, v1, v2, v3, v4, d1, d2, d3, step

C     o Do easy cases first.
      DIFFERENT_MULTIPLE = .FALSE.

      IF ( freq .NE. 0. ) THEN
        IF ( ABS(val1-val2) .GT. freq ) THEN
         DIFFERENT_MULTIPLE = .TRUE.
        ELSE

C         o This case is more complex because of round-off error
          f = freq
          v1 = val1
          v2 = val2
          step = v1-v2

C         Test v1 to see if its a "closest multiple"
          v3 = v1 + step
          v4 = NINT(v1/f)*f
          d1 = v1-v4
          d2 = v2-v4
          d3 = v3-v4
          IF ( ABS(d1) .LE. ABS(d2) .AND. ABS(d1) .LE. ABS(d3) )
     &        DIFFERENT_MULTIPLE = .TRUE.

        ENDIF ! |val1-val2| > freq
      ENDIF ! freq != 0

      END
1	cnh	1.4	C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/different_multiple.F,v 1.3 1999/05/24 14:57:55 adcroft Exp $
2			C $Name: $
3	cnh	1.1	#include "CPP_EEOPTIONS.h"
4
5			CStartofinterface
6			LOGICAL FUNCTION DIFFERENT_MULTIPLE( freq, val1, val2 )
7			C /==========================================================\
8			C \| LOGICAL FUNCTION DIFFERENT_MULTIPLE \|
9			C \| o Checks two numbers multiple of a third number. \|
10			C \|==========================================================\|
11			C \| This routine is used for diagnostic and other periodic \|
12			C \| operations. It is very sensitive to arithmetic precision.\|
13			C \| For IEEE conforming arithmetic is works well but for \|
14			C \| cases where short cut arithmetic is used it may not work\|
15			C \| as expected. To overcome this issue compile this routine \|
16			C \| separately with no optimisation. \|
17			C \==========================================================/
18			IMPLICIT NONE
19			C Returns TRUE if val1 and val2 are different multiples of freq.
20	cnh	1.2	_RL freq, val1, val2
21	cnh	1.1	CEndofinterface
22	cnh	1.2	_RL f, v1, v2, v3, v4, d1, d2, d3, step
23
24			C o Do easy cases first.
25	cnh	1.1	DIFFERENT_MULTIPLE = .FALSE.
26	adcroft	1.3
27			IF ( freq .NE. 0. ) THEN
28			IF ( ABS(val1-val2) .GT. freq ) THEN
29			DIFFERENT_MULTIPLE = .TRUE.
30			ELSE
31
32			C o This case is more complex because of round-off error
33			f = freq
34			v1 = val1
35			v2 = val2
36			step = v1-v2
37
38			C Test v1 to see if its a "closest multiple"
39			v3 = v1 + step
40			v4 = NINT(v1/f)*f
41			d1 = v1-v4
42			d2 = v2-v4
43			d3 = v3-v4
44			IF ( ABS(d1) .LE. ABS(d2) .AND. ABS(d1) .LE. ABS(d3) )
45			& DIFFERENT_MULTIPLE = .TRUE.
46
47			ENDIF ! \|val1-val2\| > freq
48			ENDIF ! freq != 0
49	cnh	1.1
50	cnh	1.2	END