--- MITgcm/eesupp/src/different_multiple.F 1998/11/03 15:28:03 1.2 +++ MITgcm/eesupp/src/different_multiple.F 2005/05/15 02:58:40 1.8 @@ -1,46 +1,68 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/eesupp/src/different_multiple.F,v 1.2 1998/11/03 15:28:03 cnh Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/eesupp/src/different_multiple.F,v 1.8 2005/05/15 02:58:40 jmc Exp $ +C $Name: $ + #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 \==========================================================/ +CBOP +C !ROUTINE: DIFFERENT_MULTIPLE + +C !INTERFACE: + LOGICAL FUNCTION DIFFERENT_MULTIPLE( freq, val1, step ) 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 !DESCRIPTION: +C *==========================================================* +C | LOGICAL FUNCTION DIFFERENT\_MULTIPLE +C | o Checks if a multiple of freq exist +C | around val1 +/- step/2 +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 freq :: Frequency by which time is divided. +C val1 :: time that is checked +C step :: length of time interval (around val1) that is checked + _RL freq, val1, step + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + +C !LOCAL VARIABLES: +C == Local variables == +C v1, v2, v3, v4 :: Temp. for holding time +C d1, d2, d3 :: Temp. for hold difference + _RL v1, v2, v3, v4, d1, d2, d3 +CEOP 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. + IF ( freq .NE. 0. ) THEN + IF ( ABS(step) .GT. freq ) THEN + DIFFERENT_MULTIPLE = .TRUE. + ELSE + +C o This case is more complex because of round-off error + v1 = val1 + v2 = val1 - step + v3 = val1 + step + +C Test v1 to see if its a "closest multiple" + v4 = NINT(v1/freq)*freq + 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 + ENDIF + RETURN END