C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_timeinterval.F,v 1.7 2013/06/03 22:27:03 heimbach Exp $
C $Name: $
#include "CAL_OPTIONS.h"
SUBROUTINE CAL_TIMEINTERVAL(
I timeint,
I timeunit,
O date,
I myThid )
C ==================================================================
C SUBROUTINE cal_TimeInterval
C ==================================================================
C
C o Create an array in date format given a time interval measured in
C units of timeunit.
C Available time units: 'secs'
C 'model'
C Fractions of seconds are not resolved in this version.
C
C started: Christian Eckert eckert@mit.edu 30-Jun-1999
C changed: Christian Eckert eckert@mit.edu 29-Dec-1999
C - restructured the original version in order to have a
C better interface to the MITgcmUV.
C Christian Eckert eckert@mit.edu 03-Feb-2000
C - Introduced new routine and function names, cal_,
C for verion 0.1.3.
C
C ==================================================================
C SUBROUTINE cal_TimeInterval
C ==================================================================
IMPLICIT NONE
C == global variables ==
#include "EEPARAMS.h"
#include "cal.h"
C == routine arguments ==
INTEGER date(4)
_RL timeint
CHARACTER*(*) timeunit
INTEGER myThid
C == local variables ==
INTEGER fac
INTEGER nsecs
INTEGER hhmmss
INTEGER ierr
_RL tmp1, tmp2
CHARACTER*(MAX_LEN_MBUF) msgBuf
C == end of interface ==
fac = 1
if (timeint .lt. 0) fac = -1
date(4) = -1
date(3) = 0
if (timeunit .eq. 'secs') then
IF ( cal_setStatus .LT. 1 ) THEN
WRITE( msgBuf,'(2A,F19.2,2A)') 'CAL_TIMEINTERVAL: ',
& 'timeint=',timeint,' , timeunit=',timeunit
CALL PRINT_ERROR( msgBuf, myThid )
WRITE( msgBuf,'(2A,I2,A)') 'CAL_TIMEINTERVAL: ',
& 'called too early (cal_setStatus=',cal_setStatus,' )'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R CAL_TIMEINTERVAL'
ENDIF
date(1) = int(timeint/float(secondsperday))
tmp1 = date(1)
tmp2 = secondsperday
nsecs = int(timeint - tmp1 * tmp2 )
else if (timeunit .eq. 'model') then
IF ( cal_setStatus .LT. 2 ) THEN
WRITE( msgBuf,'(2A,F15.2,2A)') 'CAL_TIMEINTERVAL: ',
& 'timeint=',timeint,' , timeunit=',timeunit
CALL PRINT_ERROR( msgBuf, myThid )
WRITE( msgBuf,'(2A,I2,A)') 'CAL_TIMEINTERVAL: ',
& 'called too early (cal_setStatus=',cal_setStatus,' )'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R CAL_TIMEINTERVAL'
ENDIF
date(1) = int(timeint*modelstep/float(secondsperday))
nsecs = int(timeint*modelstep -
& float(date(1)) * float(secondsperday))
else
ierr = 701
call CAL_PRINTERROR( ierr, myThid )
stop ' stopped in cal_TimeInterval.'
endif
hhmmss = nsecs/secondsperminute
date(2) = hhmmss/minutesperhour*10000 +
& (mod(fac*hhmmss,minutesperhour)*100 +
& mod(fac*nsecs,secondsperminute))*fac
RETURN
END