1 |
C $Header: /u/gcmpack/MITgcm/eesupp/src/diff_phase_multiple.F,v 1.3 2006/01/16 19:04:59 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "CPP_EEOPTIONS.h" |
5 |
|
6 |
CBOP |
7 |
C !ROUTINE: DIFF_PHASE_MULTIPLE |
8 |
|
9 |
C !INTERFACE: |
10 |
LOGICAL FUNCTION DIFF_PHASE_MULTIPLE( phase, freq, val1, step ) |
11 |
IMPLICIT NONE |
12 |
|
13 |
C !DESCRIPTION: |
14 |
C *==========================================================* |
15 |
C | LOGICAL FUNCTION DIFF\_PHASE\_MULTIPLE |
16 |
C | o Checks if a multiple of freq (+ phase shift) exist |
17 |
C | around val1 +/- step/2 |
18 |
C *==========================================================* |
19 |
C | This routine is used for diagnostic and other periodic |
20 |
C | operations. It is very sensitive to arithmetic precision. |
21 |
C | For IEEE conforming arithmetic it works well but for |
22 |
C | cases where short cut arithmetic is used it may not work |
23 |
C | as expected. To overcome this issue compile this routine |
24 |
C | separately with no optimisation. |
25 |
C *==========================================================* |
26 |
|
27 |
C !INPUT PARAMETERS: |
28 |
C == Routine arguments == |
29 |
C phase :: shift phase time |
30 |
C freq :: Frequency by which time is divided. |
31 |
C val1 :: time that is checked |
32 |
C step :: length of time interval (around val1) that is checked |
33 |
_RL phase, freq, val1, step |
34 |
|
35 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
36 |
|
37 |
C !LOCAL VARIABLES: |
38 |
C == Local variables == |
39 |
C v1, v2, v3, v4 :: Temp. for holding time |
40 |
C d1, d2, d3 :: Temp. for hold difference |
41 |
_RL v1, v2, v3, v4, d1, d2, d3 |
42 |
CEOP |
43 |
|
44 |
C o Do easy cases first. |
45 |
DIFF_PHASE_MULTIPLE = .FALSE. |
46 |
|
47 |
IF ( freq .NE. 0. ) THEN |
48 |
IF ( ABS(step) .GT. ABS(freq) ) THEN |
49 |
DIFF_PHASE_MULTIPLE = .TRUE. |
50 |
c ELSEIF ( val1+step .GE. phase+baseTime ) THEN |
51 |
C- should compare to phase+baseTime (above), but would need PARAMS.h ; |
52 |
C choose to disable this condition for negative time: |
53 |
ELSEIF ( val1+step.GE.phase .OR. val1.LT.0. ) THEN |
54 |
|
55 |
C o This case is more complex because of round-off error |
56 |
v1 = val1 |
57 |
v2 = val1 - step |
58 |
v3 = val1 + step |
59 |
|
60 |
C Test v1 to see if its a "closest multiple" |
61 |
v4 = phase + NINT((v1-phase)/freq)*freq |
62 |
d1 = v1-v4 |
63 |
d2 = v2-v4 |
64 |
d3 = v3-v4 |
65 |
IF ( ABS(d1) .LT. ABS(d2) .AND. ABS(d1) .LE. ABS(d3) ) |
66 |
& DIFF_PHASE_MULTIPLE = .TRUE. |
67 |
|
68 |
ENDIF |
69 |
ENDIF |
70 |
|
71 |
RETURN |
72 |
END |