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	C $Header: /u/gcmpack/MITgcm/eesupp/src/different_multiple.F,v 1.6 2004/03/27 03:51:51 edhill Exp $
2	C $Name: $
3	#include "CPP_EEOPTIONS.h"
4
5	CBOP
6	C !ROUTINE: DIFFERENT_MULTIPLE
7
8	C !INTERFACE:
9	LOGICAL FUNCTION DIFFERENT_MULTIPLE( freq, val1, val2 )
10	IMPLICIT NONE
11
12	C !DESCRIPTION:
13	C ==========================================================
14	C \| LOGICAL FUNCTION DIFFERENT\_MULTIPLE
15	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	_RL freq, val1, val2
30
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	_RL f, v1, v2, v3, v4, d1, d2, d3, step
38	CEOP
39
40	C o Do easy cases first.
41	DIFFERENT_MULTIPLE = .FALSE.
42
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
66	END