pkg/cal/cal_convdate.F

C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_convdate.F,v 1.1 2001/05/14 22:07:26 heimbach Exp $

#include "CAL_CPPOPTIONS.h"

      subroutine cal_ConvDate(
     I                         date,
     O                         yy, mm, dd, ss,
     O                         lp, wd,
     I                         mythid
     &                       )

c     ==================================================================
c     SUBROUTINE cal_ConvDate
c     ==================================================================
c
c     o Decompose the first part of a date array.
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              21-Sep-2003: fixed check_sign logic to work with
c              negative intervals (menemenlis@jpl.nasa.gov)
c
c     ==================================================================
c     SUBROUTINE cal_ConvDate
c     ==================================================================

      implicit none

c     == global variables ==

#include "cal.h"

c     == routine arguments ==

      integer date(4)
      integer mythid

c     == local variables ==

      integer yy
      integer mm
      integer dd
      integer ss
      integer lp
      integer wd
      integer fac
      integer date_1
      integer date_2
      integer ierr
      _RL check_sign

c     == end of interface ==

      fac = 1

c     Check the sign of the date.

      check_sign = sign(1,dble(date(1))*dble(date(2)))

      if ( check_sign .ge. 0 ) then
        if (date(1) .eq. 0) then
          date_1 = date(1)
          if (date(2) .lt. 0) then
            date_2 = -date(2)
            fac    = -1
          else
            date_2 = date(2)
            fac    = 1
          endif
        else if (date(1) .lt. 0) then
          date_1 = -date(1)
          date_2 = -date(2)
          fac    = -1
        else
          date_1 = date(1)
          date_2 = date(2)
          fac    = 1
        endif
      else

        ierr = 901
        call cal_PrintError( ierr, mythid )
        stop ' stopped in cal_ConvDate.'

      endif

c     Decompose the entries.
      if (date(4) .ne. -1) then
        yy = date_1/10000
        mm = mod(date_1/100,100)
        dd = mod(date_1,100)
      else
        yy = 0
        mm = 0
        dd = date_1
      endif
      ss = mod(date_2,100) +
     &     mod(date_2/100,100)*secondsperminute +
     &     date_2/10000*secondsperhour

c     Include the sign.
      yy = fac*yy
      mm = fac*mm
      dd = fac*dd
      ss = fac*ss

      lp = date(3)
      wd = date(4)

      return
      end

1	C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_convdate.F,v 1.1 2001/05/14 22:07:26 heimbach Exp $
2
3	#include "CAL_CPPOPTIONS.h"
4
5	subroutine cal_ConvDate(
6	I date,
7	O yy, mm, dd, ss,
8	O lp, wd,
9	I mythid
10	& )
11
12	c ==================================================================
13	c SUBROUTINE cal_ConvDate
14	c ==================================================================
15	c
16	c o Decompose the first part of a date array.
17	c
18	c started: Christian Eckert eckert@mit.edu 30-Jun-1999
19	c
20	c changed: Christian Eckert eckert@mit.edu 29-Dec-1999
21	c
22	c - restructured the original version in order to have a
23	c better interface to the MITgcmUV.
24	c
25	c Christian Eckert eckert@mit.edu 03-Feb-2000
26	c
27	c - Introduced new routine and function names, cal_<NAME>,
28	c for verion 0.1.3.
29	c
30	c 21-Sep-2003: fixed check_sign logic to work with
31	c negative intervals (menemenlis@jpl.nasa.gov)
32	c
33	c ==================================================================
34	c SUBROUTINE cal_ConvDate
35	c ==================================================================
36
37	implicit none
38
39	c == global variables ==
40
41	#include "cal.h"
42
43	c == routine arguments ==
44
45	integer date(4)
46	integer mythid
47
48	c == local variables ==
49
50	integer yy
51	integer mm
52	integer dd
53	integer ss
54	integer lp
55	integer wd
56	integer fac
57	integer date_1
58	integer date_2
59	integer ierr
60	_RL check_sign
61
62	c == end of interface ==
63
64	fac = 1
65
66	c Check the sign of the date.
67
68	check_sign = sign(1,dble(date(1))*dble(date(2)))
69
70	if ( check_sign .ge. 0 ) then
71	if (date(1) .eq. 0) then
72	date_1 = date(1)
73	if (date(2) .lt. 0) then
74	date_2 = -date(2)
75	fac = -1
76	else
77	date_2 = date(2)
78	fac = 1
79	endif
80	else if (date(1) .lt. 0) then
81	date_1 = -date(1)
82	date_2 = -date(2)
83	fac = -1
84	else
85	date_1 = date(1)
86	date_2 = date(2)
87	fac = 1
88	endif
89	else
90
91	ierr = 901
92	call cal_PrintError( ierr, mythid )
93	stop ' stopped in cal_ConvDate.'
94
95	endif
96
97	c Decompose the entries.
98	if (date(4) .ne. -1) then
99	yy = date_1/10000
100	mm = mod(date_1/100,100)
101	dd = mod(date_1,100)
102	else
103	yy = 0
104	mm = 0
105	dd = date_1
106	endif
107	ss = mod(date_2,100) +
108	& mod(date_2/100,100)*secondsperminute +
109	& date_2/10000*secondsperhour
110
111	c Include the sign.
112	yy = fac*yy
113	mm = fac*mm
114	dd = fac*dd
115	ss = fac*ss
116
117	lp = date(3)
118	wd = date(4)
119
120	return
121	end
122