pkg/cal/cal_timeinterval.F

C $Header: /usr/local/gcmpack/MITgcm/pkg/cal/cal_timeinterval.F,v 1.3 2003/10/09 04:19:19 edhill 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
c       Available time units: 'secs'
c                             'model'
c
c       Fractions of seconds are not resolved in this version.
c              
c     started: Christian Eckert eckert@mit.edu  30-Jun-1999
c
c     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
c
c              - restructured the original version in order to have a
c                better interface to the MITgcmUV.
c
c              Christian Eckert eckert@mit.edu  03-Feb-2000
c
c              - Introduced new routine and function names, cal_<NAME>,
c                for verion 0.1.3.
c
c     ==================================================================
c     SUBROUTINE cal_TimeInterval
c     ==================================================================

      implicit none

c     == global variables ==

#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

c     == end of interface ==

      fac = 1
      if (timeint .lt. 0) fac = -1

      date(4) = -1
      date(3) =  0
      if (timeunit .eq. 'secs') then

        date(1) = int(timeint/float(secondsperday))
        tmp1    = date(1)
        tmp2    = secondsperday
        nsecs   = int(timeint - tmp1 * tmp2 )

      else if (timeunit .eq. 'model') then

        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
1	C $Header: /usr/local/gcmpack/MITgcm/pkg/cal/cal_timeinterval.F,v 1.3 2003/10/09 04:19:19 edhill Exp $
2	C $Name: $
3
4	#include "CAL_OPTIONS.h"
5
6	subroutine cal_TimeInterval(
7	I timeint,
8	I timeunit,
9	O date,
10	I mythid
11	& )
12
13	c ==================================================================
14	c SUBROUTINE cal_TimeInterval
15	c ==================================================================
16	c
17	c o Create an array in date format given a time interval measured in
18	c units of timeunit.
19	c
20	c Available time units: 'secs'
21	c 'model'
22	c
23	c Fractions of seconds are not resolved in this version.
24	c
25	c started: Christian Eckert eckert@mit.edu 30-Jun-1999
26	c
27	c changed: Christian Eckert eckert@mit.edu 29-Dec-1999
28	c
29	c - restructured the original version in order to have a
30	c better interface to the MITgcmUV.
31	c
32	c Christian Eckert eckert@mit.edu 03-Feb-2000
33	c
34	c - Introduced new routine and function names, cal_<NAME>,
35	c for verion 0.1.3.
36	c
37	c ==================================================================
38	c SUBROUTINE cal_TimeInterval
39	c ==================================================================
40
41	implicit none
42
43	c == global variables ==
44
45	#include "cal.h"
46
47	c == routine arguments ==
48
49	integer date(4)
50	_RL timeint
51	character() timeunit
52	integer mythid
53
54	c == local variables ==
55
56	integer fac
57	integer nsecs
58	integer hhmmss
59	integer ierr
60	_RL tmp1, tmp2
61
62	c == end of interface ==
63
64	fac = 1
65	if (timeint .lt. 0) fac = -1
66
67	date(4) = -1
68	date(3) = 0
69	if (timeunit .eq. 'secs') then
70
71	date(1) = int(timeint/float(secondsperday))
72	tmp1 = date(1)
73	tmp2 = secondsperday
74	nsecs = int(timeint - tmp1 * tmp2 )
75
76	else if (timeunit .eq. 'model') then
77
78	date(1) = int(timeint*modelstep/float(secondsperday))
79	nsecs = int(timeint*modelstep -
80	& float(date(1)) * float(secondsperday))
81
82	else
83
84	ierr = 701
85	call cal_PrintError( ierr, mythid )
86	stop ' stopped in cal_TimeInterval.'
87
88	endif
89
90	hhmmss = nsecs/secondsperminute
91	date(2) = hhmmss/minutesperhour*10000 +
92	& (mod(fachhmmss,minutesperhour)100 +
93	& mod(facnsecs,secondsperminute))fac
94
95	return
96	end