eesupp/src/diff_phase_multiple.F

920e90659a Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: DIFF_PHASE_MULTIPLE
                0005
                0006 C     !INTERFACE:
                0007       LOGICAL FUNCTION DIFF_PHASE_MULTIPLE( phase, freq, val1, step )
                0008       IMPLICIT NONE
                0009
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | LOGICAL FUNCTION DIFF\_PHASE\_MULTIPLE
                0013 C     | o Checks if a multiple of freq (+ phase shift) exist
                0014 C     |   around val1 +/- step/2
                0015 C     *==========================================================*
                0016 C     | This routine is used for diagnostic and other periodic
                0017 C     | operations. It is very sensitive to arithmetic precision.
                0018 C     | For IEEE conforming arithmetic it works well but for
                0019 C     | cases where short cut arithmetic  is used it may not work
                0020 C     | as expected. To overcome this issue compile this routine
                0021 C     | separately with no optimisation.
                0022 C     *==========================================================*
                0023
                0024 C     !INPUT PARAMETERS:
                0025 C     == Routine arguments ==
                0026 C     phase      :: shift phase time
                0027 C     freq       :: Frequency by which time is divided.
                0028 C     val1       :: time that is checked
                0029 C     step       :: length of time interval (around val1) that is checked
                0030       _RL  phase, freq, val1, step
                0031
                0032 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0033
                0034 C     !LOCAL VARIABLES:
                0035 C     == Local variables ==
                0036 C     v1, v2, v3, v4 :: Temp. for holding time
                0037 C     d1, d2, d3     :: Temp. for hold difference
                0038       _RL  v1, v2, v3, v4, d1, d2, d3
                0039 CEOP
                0040
                0041 C     o Do easy cases first.
                0042       DIFF_PHASE_MULTIPLE = .FALSE.
                0043
                0044       IF ( freq .NE. 0. ) THEN
                0045         IF ( ABS(step) .GT. ABS(freq) ) THEN
                0046          DIFF_PHASE_MULTIPLE = .TRUE.
41121dd2c8 Jean*0047 c       ELSEIF ( val1+step .GE. phase+baseTime ) THEN
                0048 C-     should compare to phase+baseTime (above), but would need PARAMS.h ;
                0049 C      choose to disable this condition for negative time:
                0050         ELSEIF ( val1+step.GE.phase .OR. val1.LT.0. ) THEN
920e90659a Jean*0051
                0052 C         o This case is more complex because of round-off error
                0053           v1 = val1
                0054           v2 = val1 - step
                0055           v3 = val1 + step
                0056
                0057 C         Test v1 to see if its a "closest multiple"
                0058           v4 = phase + NINT((v1-phase)/freq)*freq
                0059           d1 = v1-v4
                0060           d2 = v2-v4
                0061           d3 = v3-v4
c475e28026 Jean*0062           IF ( ABS(d1) .LT. ABS(d2) .AND. ABS(d1) .LE. ABS(d3) )
920e90659a Jean*0063      &        DIFF_PHASE_MULTIPLE = .TRUE.
                0064
                0065         ENDIF
                0066       ENDIF
                0067
                0068       RETURN
                0069       END