eesupp/src/different_multiple.F

C     $Header: /u/gcmpack/MITgcm/eesupp/src/different_multiple.F,v 1.6 2004/03/27 03:51:51 edhill Exp $
C $Name:  $
#include "CPP_EEOPTIONS.h"

CBOP
C     !ROUTINE: DIFFERENT_MULTIPLE

C     !INTERFACE:
      LOGICAL FUNCTION DIFFERENT_MULTIPLE( freq, val1, val2 )
      IMPLICIT NONE

C     !DESCRIPTION:
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 it 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     *==========================================================*

C     !INPUT PARAMETERS:
C     == Routine arguments ==
C     val1, val2 :: Two times that are checked 
C     freq       :: Frequency by which times are divided.
      _RL  freq, val1, val2

C     !LOCAL VARIABLES:
C     == Local variables ==
C     f              :: Temp. for holding freq
C     v1, v2, v3, v4 :: Temp. for holding time
C     d1, d2, d3     :: Temp. for hold difference
C     step           :: Temp. for hold difference used as increment
      _RL  f, v1, v2, v3, v4, d1, d2, d3, step
CEOP

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	jmc	1.7	C $Header: /u/gcmpack/MITgcm/eesupp/src/different_multiple.F,v 1.6 2004/03/27 03:51:51 edhill Exp $
2	cnh	1.5	C $Name: $
3	cnh	1.1	#include "CPP_EEOPTIONS.h"
4
5	cnh	1.5	CBOP
6			C !ROUTINE: DIFFERENT_MULTIPLE
7
8			C !INTERFACE:
9	cnh	1.1	LOGICAL FUNCTION DIFFERENT_MULTIPLE( freq, val1, val2 )
10			IMPLICIT NONE
11	cnh	1.5
12			C !DESCRIPTION:
13			C ==========================================================
14	edhill	1.6	C \| LOGICAL FUNCTION DIFFERENT\_MULTIPLE
15	cnh	1.5	C \| o Checks two numbers multiple of a third number.
16			C ==========================================================
17			C \| This routine is used for diagnostic and other periodic
18			C \| operations. It is very sensitive to arithmetic precision.
19			C \| For IEEE conforming arithmetic it works well but for
20			C \| cases where short cut arithmetic is used it may not work
21			C \| as expected. To overcome this issue compile this routine
22			C \| separately with no optimisation.
23			C ==========================================================
24
25			C !INPUT PARAMETERS:
26			C == Routine arguments ==
27			C val1, val2 :: Two times that are checked
28			C freq :: Frequency by which times are divided.
29	cnh	1.2	_RL freq, val1, val2
30	cnh	1.5
31			C !LOCAL VARIABLES:
32			C == Local variables ==
33			C f :: Temp. for holding freq
34			C v1, v2, v3, v4 :: Temp. for holding time
35			C d1, d2, d3 :: Temp. for hold difference
36			C step :: Temp. for hold difference used as increment
37	cnh	1.2	_RL f, v1, v2, v3, v4, d1, d2, d3, step
38	cnh	1.5	CEOP
39	cnh	1.2
40			C o Do easy cases first.
41	cnh	1.1	DIFFERENT_MULTIPLE = .FALSE.
42	adcroft	1.3
43			IF ( freq .NE. 0. ) THEN
44			IF ( ABS(val1-val2) .GT. freq ) THEN
45			DIFFERENT_MULTIPLE = .TRUE.
46			ELSE
47
48			C o This case is more complex because of round-off error
49			f = freq
50			v1 = val1
51			v2 = val2
52			step = v1-v2
53
54			C Test v1 to see if its a "closest multiple"
55			v3 = v1 + step
56			v4 = NINT(v1/f)*f
57			d1 = v1-v4
58			d2 = v2-v4
59			d3 = v3-v4
60			IF ( ABS(d1) .LE. ABS(d2) .AND. ABS(d1) .LE. ABS(d3) )
61			& DIFFERENT_MULTIPLE = .TRUE.
62
63			ENDIF ! \|val1-val2\| > freq
64			ENDIF ! freq != 0
65	cnh	1.1
66	cnh	1.2	END