C $Header: /u/gcmpack/MITgcm/eesupp/src/get_periodic_interval.F,v 1.2 2011/04/20 01:36:09 jmc Exp $
C $Name: $
#include "CPP_EEOPTIONS.h"
CBOP
C !ROUTINE: GET_PERIODIC_INTERVAL
C !INTERFACE:
SUBROUTINE GET_PERIODIC_INTERVAL(
O tRec0, tRec1, tRec2, wght1, wght2,
I cycleLength, recSpacing, deltaT,
I currentTime, myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE GET\_PERIODIC\_INTERVAL
C | o Provide time-record indices arround current time
C | from a periodic, regularly spaced, time sequence
C | o Extended to non-periodic, regularly spaced, time
C | sequence (case cycleLength=0) as in pkg/rbcs
C *==========================================================*
C | From a regularly-spaced sequence of time records
C | this routine returns the index of the two records
C | surrounding the current time and the record index of
C | corresponding to the previous time-step ; also provides
C | the weighting factor for a linear interpolation
C *==========================================================*
C !USES:
IMPLICIT NONE
#include "EEPARAMS.h"
C !INPUT PARAMETERS:
C cycleLength :: length of the periodic cycle (in s), zero if non-periodic
C recSpacing :: time record spacing
C deltaT :: time-step
C currentTime :: current time
C myThid :: my Thread Id number
_RL cycleLength, recSpacing, deltaT, currentTime
INTEGER myThid
C !OUTPUT PARAMETERS:
C tRec0 :: time-record intex corresponding to the previous time-step
C tRec1 :: 1rst time-record intex just before current time
C tRec2 :: 2nd time-record intex just after current time
C wght1 :: linear interpolation weight (applies to 1rst record)
C wght2 :: linear interpolation weight (applies to 2nd record)
INTEGER tRec0, tRec1, tRec2
_RL wght1, wght2
C !LOCAL VARIABLES:
C == Local variables ==
C nbRec :: number of time-records
C msgBuf :: Informational/error message buffer
INTEGER nbRec
CHARACTER*(MAX_LEN_MBUF) msgBuf
_RL locTime, modTime, tmpTime
CEOP
C Implicit function:
_RL F90MODULO, arg1, arg2
C statement function to emulate Fortran 90 MODULO
C this modulo has the same sign as arg2 (and absolute value < |arg2|)
F90MODULO(arg1,arg2) = MOD(MOD(arg1,arg2)+arg2,arg2)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
tRec0 = 0
tRec1 = 0
tRec2 = 0
wght1 = 0.
wght2 = 0.
IF ( cycleLength.LT.0. .OR.
& recSpacing .LE.0. ) THEN
IF ( cycleLength.LT.0. ) WRITE(msgBuf,'(A)')
& 'GET_PERIODIC_INTERVAL requires cycleLength >= 0'
IF ( recSpacing .LE.0. ) WRITE(msgBuf,'(A)')
& 'GET_PERIODIC_INTERVAL requires recSpacing > 0'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(A,2(A,1PE16.8))') 'GET_PERIODIC_INTERVAL: ',
& 'cycleLength=', cycleLength, ' , recSpacing=', recSpacing
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R GET_PERIODIC_INTERVAL'
ELSE
nbRec = NINT(cycleLength/recSpacing)
ENDIF
tmpTime = nbRec*recSpacing
IF ( cycleLength.NE.tmpTime ) THEN
WRITE(msgBuf,'(2A,I5,A)') 'GET_PERIODIC_INTERVAL: ',
& 'cycleLength not multiple of recSpacing:'
CALL PRINT_ERROR( msgBuf, myThid )
WRITE(msgBuf,'(A,2(A,1PE16.8))') 'GET_PERIODIC_INTERVAL: ',
& 'cycleLength=', cycleLength, ' , recSpacing=', recSpacing
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R GET_PERIODIC_INTERVAL'
ENDIF
IF ( cycleLength.EQ.0. _d 0 ) THEN
C-- Non-periodic time-record sequence:
locTime = currentTime - recSpacing*0.5
modTime = F90MODULO(locTime,recSpacing)
C- time-record before (tRec1) and after (tRec2) current time:
tRec1 = 1 + NINT( (locTime-modTime)/recSpacing )
tRec2 = 1 + tRec1
C- linear interpolation weights:
wght2 = modTime / recSpacing
wght1 = 1. _d 0 - wght2
C- previous time-step record:
locTime = locTime-deltaT
modTime = F90MODULO( locTime, recSpacing )
tRec0 = 1 + NINT( (locTime-modTime)/recSpacing )
ELSE
C-- Periodic time-record sequence:
locTime = currentTime - recSpacing*0.5
& + cycleLength*( 2 - NINT(currentTime/cycleLength) )
C- time-record before (tRec1) and after (tRec2) current time:
tmpTime = MOD( locTime, cycleLength )
tRec1 = 1 + INT( tmpTime/recSpacing )
tRec2 = 1 + MOD( tRec1, nbRec )
C- linear interpolation weights:
wght2 = ( tmpTime - recSpacing*(tRec1 - 1) )/recSpacing
wght1 = 1. _d 0 - wght2
C- previous time-step record:
tmpTime = MOD( locTime-deltaT, cycleLength )
tRec0 = 1 + INT(tmpTime/recSpacing)
ENDIF
RETURN
END