eesupp/src/different_multiple.F

C     $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/different_multiple.F,v 1.1 1998/05/21 18:30:08 cnh Exp $
#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 .EQ. 0. ) RETURN
      IF ( ABS(val1-val2) .GT. freq ) THEN
       DIFFERENT_MULTIPLE = .TRUE.
       RETURN
      ENDIF

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.

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