1 |
C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/cal/cal_addtime.F,v 1.5 2001/02/02 16:57:22 heimbach Exp $ |
2 |
|
3 |
#include "CAL_CPPOPTIONS.h" |
4 |
|
5 |
subroutine cal_AddTime( |
6 |
I date, |
7 |
I interval, |
8 |
O added, |
9 |
I mythid |
10 |
& ) |
11 |
|
12 |
c ================================================================== |
13 |
c SUBROUTINE cal_AddTime |
14 |
c ================================================================== |
15 |
c |
16 |
c o Add a time interval either to a calendar date or to a time |
17 |
c interval. |
18 |
c |
19 |
c started: Christian Eckert eckert@mit.edu 30-Jun-1999 |
20 |
c |
21 |
c changed: Christian Eckert eckert@mit.edu 29-Dec-1999 |
22 |
c |
23 |
c - restructured the original version in order to have a |
24 |
c better interface to the MITgcmUV. |
25 |
c |
26 |
c Christian Eckert eckert@mit.edu 03-Feb-2000 |
27 |
c |
28 |
c - Introduced new routine and function names, cal_<NAME>, |
29 |
c for verion 0.1.3. |
30 |
c |
31 |
c ralf.giering@fastopt.de 31-May-2000 |
32 |
c datesecs was computed at wrong place (cph) |
33 |
c |
34 |
c ================================================================== |
35 |
c SUBROUTINE cal_AddTime |
36 |
c ================================================================== |
37 |
|
38 |
implicit none |
39 |
|
40 |
c == global variables == |
41 |
|
42 |
#include "cal.h" |
43 |
|
44 |
c == routine arguments == |
45 |
|
46 |
integer date(4) |
47 |
integer interval(4) |
48 |
integer added(4) |
49 |
integer mythid |
50 |
|
51 |
c == local variables == |
52 |
|
53 |
integer intsecs |
54 |
integer datesecs |
55 |
integer nsecs |
56 |
integer hhmmss |
57 |
integer yi,mi,di,si,li,wi |
58 |
integer ndays |
59 |
integer date_1,date_2 |
60 |
integer intv_1,intv_2 |
61 |
integer fac |
62 |
integer iday |
63 |
integer switch |
64 |
integer ndayssub |
65 |
integer ierr |
66 |
|
67 |
c == external == |
68 |
|
69 |
integer cal_IsLeap |
70 |
external cal_IsLeap |
71 |
|
72 |
c == end of interface == |
73 |
|
74 |
date_1 = 0 |
75 |
date_2 = 0 |
76 |
|
77 |
fac = 1 |
78 |
|
79 |
if (interval(4) .eq. -1) then |
80 |
|
81 |
if (date(4) .eq. -1) then |
82 |
if (date(1) .ge. 0) then |
83 |
date_1 = date(1) |
84 |
date_2 = date(2) |
85 |
intv_1 = interval(1) |
86 |
intv_2 = interval(2) |
87 |
else |
88 |
if (interval(1) .lt. 0) then |
89 |
date_1 = -date(1) |
90 |
date_2 = -date(2) |
91 |
intv_1 = -interval(1) |
92 |
intv_2 = -interval(2) |
93 |
fac = -1 |
94 |
else |
95 |
date_1 = interval(1) |
96 |
date_2 = interval(2) |
97 |
intv_1 = date(1) |
98 |
intv_2 = date(2) |
99 |
fac = 1 |
100 |
endif |
101 |
endif |
102 |
else |
103 |
if (interval(1) .ge. 0) then |
104 |
intv_1 = interval(1) |
105 |
intv_2 = interval(2) |
106 |
else |
107 |
intv_1 = -interval(1) |
108 |
intv_2 = -interval(2) |
109 |
fac = -1 |
110 |
endif |
111 |
endif |
112 |
|
113 |
intsecs = fac*(intv_2/10000*secondsperhour + |
114 |
& (mod(intv_2/100,100)*secondsperminute + |
115 |
& mod(intv_2,100))) |
116 |
|
117 |
if (date(4) .eq. -1) then |
118 |
datesecs = date_2/10000*secondsperhour + |
119 |
& mod(date_2/100,100)*secondsperminute + |
120 |
& mod(date_2,100) |
121 |
date_1 = date_1 + intv_1 |
122 |
nsecs = datesecs + intsecs |
123 |
if ((date_1 .gt. 0) .and. |
124 |
& (nsecs .lt. 0)) then |
125 |
date_1 = date_1 - 1 |
126 |
nsecs = nsecs + secondsperday |
127 |
endif |
128 |
nsecs = fac*nsecs |
129 |
yi = 0 |
130 |
mi = 0 |
131 |
di = fac*date_1 |
132 |
li = 0 |
133 |
wi = -1 |
134 |
else |
135 |
call cal_ConvDate( date,yi,mi,di,si,li,wi,mythid ) |
136 |
if ((interval(1) .ge. 0) .and. |
137 |
& (interval(2) .ge. 0)) then |
138 |
nsecs = si + intsecs |
139 |
ndays = nsecs/secondsperday |
140 |
nsecs = mod(nsecs,secondsperday) |
141 |
do iday = 1,interval(1)+ndays |
142 |
di = di + 1 |
143 |
if (di .gt. ndaymonth(mi,li)) then |
144 |
di = 1 |
145 |
mi = mi + 1 |
146 |
endif |
147 |
switch = (mi-1)/nmonthyear |
148 |
yi = yi + switch |
149 |
mi = mod(mi-1,nmonthyear)+1 |
150 |
if (switch .eq. 1) li = cal_IsLeap( yi, mythid ) |
151 |
enddo |
152 |
wi = mod(wi+interval(1)+ndays-1,7)+1 |
153 |
else |
154 |
nsecs = si + intsecs |
155 |
if (nsecs .ge. 0) then |
156 |
ndayssub = intv_1 |
157 |
else |
158 |
nsecs = nsecs + secondsperday |
159 |
ndayssub = intv_1 + 1 |
160 |
endif |
161 |
do iday = 1,ndayssub |
162 |
di = di - 1 |
163 |
if (di .eq. 0) then |
164 |
mi = mod(mi+10,nmonthyear)+1 |
165 |
switch = mi/nmonthyear |
166 |
yi = yi - switch |
167 |
if (switch .eq. 1) li = cal_IsLeap( yi, mythid ) |
168 |
di = ndaymonth(mi,li) |
169 |
endif |
170 |
enddo |
171 |
wi = mod(wi+6-mod(ndayssub,7),7)+1 |
172 |
endif |
173 |
endif |
174 |
|
175 |
c Convert to calendar format. |
176 |
added(1) = yi*10000 + mi*100 + di |
177 |
hhmmss = nsecs/secondsperminute |
178 |
added(2) = hhmmss/minutesperhour*10000 + |
179 |
& (mod(fac*hhmmss,minutesperhour)*100 + |
180 |
& mod(fac*nsecs,secondsperminute))*fac |
181 |
added(3) = li |
182 |
added(4) = wi |
183 |
else |
184 |
|
185 |
ierr = 601 |
186 |
call cal_PrintError( ierr, mythid) |
187 |
stop ' stopped in cal_AddTime.' |
188 |
|
189 |
endif |
190 |
|
191 |
return |
192 |
end |
193 |
|