eesupp/src/get_periodic_interval.F

97c37ca14a Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: GET_PERIODIC_INTERVAL
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE GET_PERIODIC_INTERVAL(
                0008      O               tRec0, tRec1, tRec2, wght1, wght2,
                0009      I               cycleLength, recSpacing, deltaT,
                0010      I               currentTime, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     *==========================================================*
                0014 C     | SUBROUTINE GET\_PERIODIC\_INTERVAL
                0015 C     | o Provide time-record indices arround current time
                0016 C     |   from a periodic, regularly spaced, time sequence
6420b04106 Jean*0017 C     | o Extended to non-periodic, regularly spaced, time
                0018 C     |   sequence (case cycleLength=0) as in pkg/rbcs
97c37ca14a Jean*0019 C     *==========================================================*
6420b04106 Jean*0020 C     | From a regularly-spaced sequence of time records
97c37ca14a Jean*0021 C     | this routine returns the index of the two records
                0022 C     | surrounding the current time and the record index of
                0023 C     | corresponding to the previous time-step ; also provides
                0024 C     | the weighting factor for a linear interpolation
                0025 C     *==========================================================*
                0026
                0027 C     !USES:
                0028       IMPLICIT NONE
                0029 #include "EEPARAMS.h"
                0030
                0031 C     !INPUT PARAMETERS:
6420b04106 Jean*0032 C     cycleLength :: length of the periodic cycle (in s), zero if non-periodic
97c37ca14a Jean*0033 C     recSpacing  :: time record spacing
                0034 C     deltaT      :: time-step
                0035 C     currentTime :: current time
                0036 C     myThid      :: my Thread Id number
                0037       _RL      cycleLength, recSpacing, deltaT, currentTime
                0038       INTEGER  myThid
                0039 C     !OUTPUT PARAMETERS:
                0040 C     tRec0       :: time-record intex corresponding to the previous time-step
                0041 C     tRec1       :: 1rst time-record intex just before current time
                0042 C     tRec2       ::  2nd time-record intex just after current time
                0043 C     wght1       :: linear interpolation weight (applies to 1rst record)
                0044 C     wght2       :: linear interpolation weight (applies to 2nd  record)
                0045       INTEGER  tRec0, tRec1, tRec2
                0046       _RL      wght1, wght2
                0047
                0048 C     !LOCAL VARIABLES:
                0049 C     == Local variables ==
                0050 C     nbRec       :: number of time-records
                0051 C     msgBuf      :: Informational/error message buffer
                0052       INTEGER  nbRec
                0053       CHARACTER*(MAX_LEN_MBUF) msgBuf
6420b04106 Jean*0054       _RL      locTime, modTime, tmpTime
97c37ca14a Jean*0055 CEOP
                0056
6420b04106 Jean*0057 C     Implicit function:
                0058       _RL F90MODULO, arg1, arg2
                0059 C statement function to emulate Fortran 90 MODULO
                0060 C this modulo has the same sign as arg2 (and absolute value < |arg2|)
                0061       F90MODULO(arg1,arg2) = MOD(MOD(arg1,arg2)+arg2,arg2)
                0062
                0063 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0064
97c37ca14a Jean*0065       tRec0 = 0
                0066       tRec1 = 0
                0067       tRec2 = 0
                0068       wght1 = 0.
                0069       wght2 = 0.
                0070
6420b04106 Jean*0071       IF ( cycleLength.LT.0. .OR.
97c37ca14a Jean*0072      &     recSpacing .LE.0. ) THEN
6420b04106 Jean*0073         IF ( cycleLength.LT.0. ) WRITE(msgBuf,'(A)')
                0074      &      'GET_PERIODIC_INTERVAL requires cycleLength >= 0'
97c37ca14a Jean*0075         IF ( recSpacing .LE.0. ) WRITE(msgBuf,'(A)')
                0076      &      'GET_PERIODIC_INTERVAL requires recSpacing > 0'
                0077         CALL PRINT_ERROR( msgBuf, myThid )
                0078         WRITE(msgBuf,'(A,2(A,1PE16.8))') 'GET_PERIODIC_INTERVAL: ',
                0079      &     'cycleLength=', cycleLength, ' , recSpacing=', recSpacing
                0080         CALL PRINT_ERROR( msgBuf, myThid )
                0081         STOP 'ABNORMAL END: S/R GET_PERIODIC_INTERVAL'
                0082       ELSE
                0083         nbRec = NINT(cycleLength/recSpacing)
                0084       ENDIF
                0085       tmpTime = nbRec*recSpacing
                0086       IF ( cycleLength.NE.tmpTime ) THEN
                0087         WRITE(msgBuf,'(2A,I5,A)') 'GET_PERIODIC_INTERVAL: ',
                0088      &     'cycleLength not multiple of recSpacing:'
                0089         CALL PRINT_ERROR( msgBuf, myThid )
                0090         WRITE(msgBuf,'(A,2(A,1PE16.8))') 'GET_PERIODIC_INTERVAL: ',
                0091      &     'cycleLength=', cycleLength, ' , recSpacing=', recSpacing
                0092         CALL PRINT_ERROR( msgBuf, myThid )
                0093         STOP 'ABNORMAL END: S/R GET_PERIODIC_INTERVAL'
                0094       ENDIF
                0095
6420b04106 Jean*0096       IF ( cycleLength.EQ.0. _d 0 ) THEN
                0097 C--   Non-periodic time-record sequence:
                0098
                0099         locTime = currentTime - recSpacing*0.5
                0100         modTime = F90MODULO(locTime,recSpacing)
97c37ca14a Jean*0101
                0102 C-    time-record before (tRec1) and after (tRec2) current time:
6420b04106 Jean*0103         tRec1 = 1 + NINT( (locTime-modTime)/recSpacing )
                0104         tRec2 = 1 + tRec1
97c37ca14a Jean*0105
                0106 C-    linear interpolation weights:
6420b04106 Jean*0107         wght2 = modTime / recSpacing
                0108         wght1 = 1. _d 0 - wght2
97c37ca14a Jean*0109
                0110 C-    previous time-step record:
6420b04106 Jean*0111         locTime = locTime-deltaT
                0112         modTime = F90MODULO( locTime, recSpacing )
                0113         tRec0 = 1 + NINT( (locTime-modTime)/recSpacing )
                0114
                0115       ELSE
                0116 C--   Periodic time-record sequence:
                0117
                0118         locTime = currentTime - recSpacing*0.5
                0119      &          + cycleLength*( 2 - NINT(currentTime/cycleLength) )
                0120
                0121 C-    time-record before (tRec1) and after (tRec2) current time:
                0122         tmpTime = MOD( locTime, cycleLength )
                0123         tRec1 = 1 + INT( tmpTime/recSpacing )
                0124         tRec2 = 1 + MOD( tRec1, nbRec )
                0125
                0126 C-    linear interpolation weights:
                0127         wght2 = ( tmpTime - recSpacing*(tRec1 - 1) )/recSpacing
                0128         wght1 = 1. _d 0 - wght2
                0129
                0130 C-    previous time-step record:
                0131         tmpTime = MOD( locTime-deltaT, cycleLength )
                0132         tRec0 = 1 + INT(tmpTime/recSpacing)
                0133
                0134       ENDIF
97c37ca14a Jean*0135
                0136       RETURN
                0137       END