/[MITgcm]/MITgcm/eesupp/src/different_multiple.F
ViewVC logotype

Contents of /MITgcm/eesupp/src/different_multiple.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.6 - (show annotations) (download)
Sat Mar 27 03:51:51 2004 UTC (20 years, 3 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint57b_post, checkpoint56b_post, checkpoint54d_post, checkpoint54e_post, checkpoint57d_post, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint54f_post, checkpoint55i_post, checkpoint55c_post, checkpoint53d_post, checkpoint57a_post, checkpoint54b_post, checkpoint52m_post, checkpoint55g_post, checkpoint57c_post, checkpoint55d_post, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint55f_post, checkpoint53g_post, eckpoint57e_pre, checkpoint56a_post, checkpoint53f_post, checkpoint57f_pre, checkpoint52n_post, checkpoint53b_pre, checkpoint56c_post, checkpoint57a_pre, checkpoint55a_post, checkpoint53b_post, checkpoint53d_pre, checkpoint55e_post, checkpoint54c_post
Changes since 1.5: +2 -2 lines 
 o cleanup comments (NO CODE CHANGES) in eesupp for protex
 o the "api reference" framework now builds documentation for:
     eesupp, pkg/generic_advdiff, and pkg/gmredi
 o remove mnc from the default gfd in pkg_groups pending
     further testing on systems where NetCDF is not installed
1 C $Header: /u/gcmpack/MITgcm/eesupp/src/different_multiple.F,v 1.5 2001/09/21 03:54:34 cnh 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
  ViewVC Help
Powered by ViewVC 1.1.22