pkg/cal/cal_convdate.F

C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/cal/cal_convdate.F,v 1.4 2001/02/02 16:57:22 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     ==================================================================
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 check_sign_1
      integer check_sign_2
      integer ierr

c     == end of interface ==

      fac = 1

c     Check the sign of the date.

      check_sign_1 = sign(1,date(1))
      check_sign_2 = sign(1,date(2))

      if ( check_sign_1*check_sign_2 .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	heimbach	1.1	C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/cal/cal_convdate.F,v 1.4 2001/02/02 16:57:22 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 ==================================================================
31			c SUBROUTINE cal_ConvDate
32			c ==================================================================
33
34			implicit none
35
36			c == global variables ==
37
38			#include "cal.h"
39
40			c == routine arguments ==
41
42			integer date(4)
43			integer mythid
44
45			c == local variables ==
46
47			integer yy
48			integer mm
49			integer dd
50			integer ss
51			integer lp
52			integer wd
53			integer fac
54			integer date_1
55			integer date_2
56			integer check_sign_1
57			integer check_sign_2
58			integer ierr
59
60			c == end of interface ==
61
62			fac = 1
63
64			c Check the sign of the date.
65
66			check_sign_1 = sign(1,date(1))
67			check_sign_2 = sign(1,date(2))
68
69			if ( check_sign_1*check_sign_2 .ge. 0 ) then
70			if (date(1) .eq. 0) then
71			date_1 = date(1)
72			if (date(2) .lt. 0) then
73			date_2 = -date(2)
74			fac = -1
75			else
76			date_2 = date(2)
77			fac = 1
78			endif
79			else if (date(1) .lt. 0) then
80			date_1 = -date(1)
81			date_2 = -date(2)
82			fac = -1
83			else
84			date_1 = date(1)
85			date_2 = date(2)
86			fac = 1
87			endif
88			else
89
90			ierr = 901
91			call cal_PrintError( ierr, mythid )
92			stop ' stopped in cal_ConvDate.'
93
94			endif
95
96			c Decompose the entries.
97			if (date(4) .ne. -1) then
98			yy = date_1/10000
99			mm = mod(date_1/100,100)
100			dd = mod(date_1,100)
101			else
102			yy = 0
103			mm = 0
104			dd = date_1
105			endif
106			ss = mod(date_2,100) +
107			& mod(date_2/100,100)*secondsperminute +
108			& date_2/10000*secondsperhour
109
110			c Include the sign.
111			yy = fac*yy
112			mm = fac*mm
113			dd = fac*dd
114			ss = fac*ss
115
116			lp = date(3)
117			wd = date(4)
118
119			return
120			end
121