libtime++: Date and time calculation
testlibtime.f
Go to the documentation of this file.
1 c this is <testlibtime.f>
2 c
3 c Copyright 1997 Thomas Forbriger
4 c
5 c a program to test libtime.a
6 c
7 c ----
8 c libtime is free software; you can redistribute it and/or modify
9 c it under the terms of the GNU General Public License as published by
10 c the Free Software Foundation; either version 2 of the License, or
11 c (at your option) any later version.
12 c
13 c This program is distributed in the hope that it will be useful,
14 c but WITHOUT ANY WARRANTY; without even the implied warranty of
15 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 c GNU General Public License for more details.
17 c
18 c You should have received a copy of the GNU General Public License
19 c along with this program; if not, write to the Free Software
20 c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
21 c ----
22 c
23 c 05/12/2007 internal functions are tested after migration to g77 on
24 c fenoglio; SFF reading waits for migration of libsffu
25 c
26 
27  program testlibtime
28 c
29  integer date1(7), date2(7), date3(7), iargc, day, month, year
30  character*40 string, filename
31  character*40 date, time
32  character*200 line
33  character*132 wid2line
34  real sffu_seconds, seconds
35  real time_libversion
36 
37  date1(1)=97
38  date1(2)=150
39  date1(3)=12
40  date1(4)=10
41  date1(5)=9
42  date1(6)=123
43  date1(7)=456
44 
45  call head('time_libversion')
46  print *,'libversion: ',time_libversion()
47 
48  call head('time_isleapyear')
49  call testleap(2000)
50  call testleap(1996)
51  call testleap(1997)
52  call testleap(92)
53  call testleap(0)
54  call testleap(1900)
55 
56  call head('time_fullyear')
57  year=0
58  call time_fullyear(year)
59  print *,'year 0: ',year
60  year=15
61  call time_fullyear(year)
62  print *,'year 15: ',year
63  year=97
64  call time_fullyear(year)
65  print *,'year 97: ',year
66  year=70
67  call time_fullyear(year)
68  print *,'year 70: ',year
69  year=100
70  call time_fullyear(year)
71  print *,'year 100: ',year
72  year=69
73  call time_fullyear(year)
74  print *,'year 69: ',year
75  year=99
76  call time_fullyear(year)
77  print *,'year 99: ',year
78  year=1831
79  call time_fullyear(year)
80  print *,'year 1831: ',year
81  year=2061
82  call time_fullyear(year)
83  print *,'year 2061: ',year
84  call time_fullyear(date1(1))
85  call time_sprint(date1, string)
86  print *,'full year: ',string
87  date1(1)=50
88  call time_fullyear(date1(1))
89  call time_sprint(date1, string)
90  print *,'full year 50: ',string
91 
92  call head('time_sprint (time_getdate is implicit)')
93  date1(1)=97
94  date1(2)=150
95  date1(3)=12
96  date1(4)=10
97  date1(5)=9
98  date1(6)=123
99  date1(7)=456
100  call arout(date1)
101  call time_sprint(date1, string)
102  print *,'date: ',string
103  date1(1)=96
104  call time_sprint(date1, string)
105  print *,'other year: ',string
106  date1(2)=366
107  call time_sprint(date1, string)
108  print *,'last doy (set by doy): ',string
109  date1(1)=0
110  date1(2)=12345
111  call time_sprint(date1, string)
112  print *,'relative time value: ',string
113 
114  call head('time_setdoy')
115  date1(1)=97
116  date1(2)=150
117  date1(3)=12
118  date1(4)=10
119  date1(5)=9
120  date1(6)=123
121  date1(7)=456
122  call time_setdoy(1, 1, date1)
123  call time_sprint(date1, string)
124  print *,'jan first: ',string
125  call time_setdoy(31, 12, date1)
126  call time_sprint(date1, string)
127  print *,'dec last: ',string
128 
129  call head('time_clear')
130  call time_clear(date1)
131  call arout(date1)
132  call time_sprint(date1, string)
133  print *,'after clear: ',string
134 
135  call head('time_norm')
136  date1(1)=96
137  date1(2)=1
138  date1(3)=24
139  date1(4)=60
140  date1(5)=60
141  date1(6)=1000
142  date1(7)=1000
143  call arout(date1)
144  call time_norm(date1)
145  call arout(date1)
146  call time_sprint(date1, string)
147  print *,'after norm: ',string
148  date1(1)=96
149  date1(2)=1
150  date1(3)=0
151  date1(4)=0
152  date1(5)=0
153  date1(6)=000
154  date1(7)=-1
155  call arout(date1)
156  call time_norm(date1)
157  call arout(date1)
158  call time_sprint(date1, string)
159  print *,'after norm: ',string
160  date1(1)=0
161  date1(2)=5003
162  date1(3)=24
163  date1(4)=60
164  date1(5)=60
165  date1(6)=1000
166  date1(7)=1000
167  call arout(date1)
168  call time_norm(date1)
169  call arout(date1)
170  call time_sprint(date1, string)
171  print *,'after norm: ',string
172  date1(1)=0
173  date1(2)=123
174  date1(3)=0
175  date1(4)=0
176  date1(5)=0
177  date1(6)=000
178  date1(7)=-1
179  call arout(date1)
180  call time_norm(date1)
181  call arout(date1)
182  call time_sprint(date1, string)
183  print *,'after norm: ',string
184 
185  call head('time_getdate after time_clear')
186  call time_clear(date1)
187  call arout(date1)
188  call time_getdate(day, month, date1)
189  print *,'date after time_clear ',day,month
190 
191  call head('time_add and time_sub')
192  date1(1)=1997
193  date1(2)=150
194  date1(3)=12
195  date1(4)=34
196  date1(5)=56
197  date1(6)=123
198  date1(7)=456
199 
200  call subhead('absolute & absolute')
201  call time_copy(date1, date2)
202  date2(1)=1999
203  call subaddtest(date1, date2)
204  call subaddtest(date2, date1)
205  call time_copy(date1, date2)
206  date2(3)=11
207  date2(4)=33
208  date2(5)=55
209  date2(6)=122
210  date2(7)=455
211  call subaddtest(date2, date1)
212  date2(6)=127
213  call subaddtest(date2, date1)
214 
215  call subhead('absolute & relative')
216  call time_clear(date2)
217  date2(2)=12
218  date2(3)=40
219  date2(4)=40
220  date2(5)=20
221  date2(6)=20
222  date2(7)=20
223  call subaddtest(date2, date1)
224  call subaddtest(date1, date2)
225 
226  call subhead('relative & relative')
227  date1(1)=0
228  date1(2)=10
229  date1(3)=11
230  date1(4)=12
231  date1(5)=13
232  date1(6)=14
233  date1(7)=15
234  date1(1)=0
235  date1(2)=1
236  date1(3)=12
237  date1(4)=13
238  date1(5)=14
239  date1(6)=15
240  date1(7)=16
241  call subaddtest(date2, date1)
242  call subaddtest(date1, date2)
243 
244  call head('time_copy')
245  date1(1)=1997
246  date1(2)=150
247  date1(3)=12
248  date1(4)=30
249  date1(5)=31
250  date1(6)=123
251  date1(7)=456
252  call time_clear(date2)
253  call time_sprint(date1, string)
254  print *,'date1: ',string
255  call time_sprint(date2, string)
256  print *,'date2 after clear: ',string
257  call time_copy(date1, date2)
258  call time_sprint(date2, string)
259  print *,'date2 after copy: ',string
260 
261  call head('time_finish')
262  date1(1)=57
263  date1(2)=450
264  date1(3)=12
265  date1(4)=0
266  date1(5)=4781
267  date1(6)=0
268  date1(7)=45456
269  call arout(date1)
270  call time_finish(date1)
271  call arout(date1)
272 
273  call head('time_compare')
274  date1(1)=1997
275  date1(2)=150
276  date1(3)=12
277  date1(4)=30
278  date1(5)=31
279  date1(6)=123
280  date1(7)=456
281  call time_copy(date1, date2)
282  call cmptest(date1, date2)
283  date1(2)=146
284  call cmptest(date1, date2)
285  date1(1)=0
286  date1(2)=5667
287  call time_copy(date1, date2)
288  date2(4)=12
289  date2(5)=45
290  call cmptest(date1, date2)
291 
292  call head('time_mul and time_div and time_nfit')
293  date1(1)=0
294  date1(2)=0
295  date1(3)=0
296  date1(4)=0
297  date1(5)=1
298  date1(6)=2
299  date1(7)=3
300  call time_copy(date1, date2)
301  date2(5)=0
302  date2(6)=1
303  date2(7)=500
304  call divmultest(date1, 5, date2)
305  call divmultest(date1, 8567, date2)
306  call divmultest(date1, 2658567, date2)
307 
308  if (iargc().eq.1) then
309  call head('sffu_timesrce and sffu_timewid2 and sffu_setwid2time')
310  call getarg(1, filename)
311  print *,'evaluate sff file ',filename
312  open(10, file=filename, status='old', err=99)
313  1 read(10, '(a200)', end=2, err=98) line
314  if (line(1:5).eq.'SRCE ') then
315  print *,'found SRCE line:'
316  print *,line(1:78)
317  date(1:6)=line(75:80)
318  time(1:10)=line(82:91)
319  call sffu_timesrce(date, time, date1)
320  call time_sprint(date1, string)
321  print *,'SRCE time: ',string
322  elseif (line(1:5).eq.'WID2 ') then
323  write(wid2line, '(a132)') line(1:132)
324  call sffu_timewid2(wid2line, date1)
325  call time_sprint(date1, string)
326  print *,'WID2 time: ',string
327  endif
328  goto 1
329  2 close(10)
330  print *,'closed file'
331  date1(1)=1997
332  date1(2)=150
333  date1(3)=12
334  date1(4)=30
335  date1(5)=31
336  date1(6)=123
337  date1(7)=456
338  call time_sprint(date1, string)
339  print *,'set WID2 to ',string
340  print *,wid2line
341  call sffu_setwid2time(wid2line, date1)
342  print *,wid2line
343  date1(1)=98
344  date1(7)=0
345  call time_sprint(date1, string)
346  print *,'set WID2 to ',string
347  print *,wid2line
348  call sffu_setwid2time(wid2line, date1)
349  call time_copy(date1, date2)
350  date2(7)=0
351  date2(6)=0
352  date2(5)=0
353  date2(4)=0
354  date2(3)=0
355  print *,wid2line
356  call time_sprint(date2, string)
357  call time_sub(date1, date2, date3)
358  print *,'time span from ',string
359  seconds=sffu_seconds(date3)
360  print *,'to first sample is ',seconds,' seconds:'
361  call time_sprint(date3, string)
362  print *,string
363  endif
364 
365  call normbugtest
366 
367  stop
368  99 stop 'ERROR: opening file'
369  98 stop 'ERROR: reading from file'
370  end
371 
372 c======================================================================
373 
374  subroutine subaddtest(date1,date2)
375  integer date1(8), date2(8), date3(8), date4(8)
376  character*40 string
377  call time_sprint(date1, string)
378  print *,'*** date1: ',string
379  call time_sprint(date2, string)
380  print *,' date2: ',string
381  call time_sub(date1, date2, date3)
382  call time_sprint(date3, string)
383  print *,' date1-date2=date3: ',string
384  call time_add(date3, date2, date4)
385  call time_sprint(date4, string)
386  print *,' date3+date2=date4: ',string
387  return
388  end
389 
390 c----------------------------------------------------------------------
391  subroutine head(routine)
392  character routine*(*)
393  print *,' '
394  print *,'TEST ',routine
395  print *,'===='
396  return
397  end
398 c----------------------------------------------------------------------
399  subroutine subhead(sub)
400  character sub*(*)
401  print *,' '
402  print *,'**** ',sub
403  print *,' '
404  return
405  end
406 c----------------------------------------------------------------------
407  subroutine arout(date)
408  integer date(7)
409  integer i
410  print 50,(date(i), i=1,7)
411  50 format('date-array: ',7(i6,1x))
412  return
413  end
414 c----------------------------------------------------------------------
415  subroutine cmptest(date1, date2)
416  integer date1(7), date2(7)
417  character*34 string1, string2
418  integer time_compare, val
419  call time_sprint(date1, string1)
420  call time_sprint(date2, string2)
421  val=time_compare(date1, date2)
422  if (val.gt.0) then
423  print *,string1, '> ',string2
424  else if (val.lt.0) then
425  print *,string1, '< ',string2
426  else
427  print *,string1, '= ',string2
428  endif
429  val=time_compare(date2, date1)
430  if (val.gt.0) then
431  print *,string2, '> ',string1
432  else if (val.lt.0) then
433  print *,string2, '< ',string1
434  else
435  print *,string2, '= ',string1
436  endif
437  return
438  end
439 c----------------------------------------------------------------------
440  subroutine divmultest(date1, n, date2)
441  integer date1(7), date2(7), n, nfit
442  integer date3(7), date4(7), rest, full(7)
443  character*40 string1, string3, string4, stringf
444  print *,'****'
445  call time_sprint(date1, string1)
446  call time_mul(date1, date3, n)
447  call time_sprint(date3, string3)
448  print *,string1,' * ',n,' -> ',string3
449  call time_nfit(date3, date1, nfit, full)
450  call time_sprint(full, stringf)
451  print *,'fitting: ',nfit,' to ',string3,' leads to ',stringf
452  call time_div(date3, date4, n, rest)
453  call time_sprint(date4, string4)
454  print *,string3,' / ',n,' -> ',string4, ' rest ', rest
455  call time_add(date3, date2, date4)
456  call time_div(date4, date3, n, rest)
457  call time_sprint(date4, string4)
458  call time_sprint(date3, string3)
459  print *,string4,' / ',n,' -> ',string3, ' rest ', rest
460  call time_nfit(date4, date1, nfit, full)
461  call time_sprint(full, stringf)
462  print *,'fitting: ',nfit,' to ',string4,' leads to ',stringf
463  call time_add(date4, date1, date3)
464  call time_sprint(date3, string3)
465  call time_nfit(date3, date1, nfit, full)
466  call time_sprint(full, stringf)
467  print *,'fitting: ',nfit,' to ',string3,' leads to ',stringf
468  return
469  end
470 c----------------------------------------------------------------------
471  subroutine testleap(year)
472  integer year
473  logical time_isleapyear
474  if (time_isleapyear(year)) then
475  else
476  print 50,year
477  endif
478  print 51,year
479  return
480  50 format('year ',i4,' is a leap year')
481  51 format('year ',i4,' is no leap year')
482  end
483 c ----------------------------------------------------------------------
484  subroutine normbugtest()
485 c
486 c test bug of norm-subroutine found in 11/2017
487 c if seconds are integer multiples of -60 or hours are integer multiples
488 c of -24 or similar, the norm function does not provide the desired
489 c output
490 c
491  integer date1(7), date2(7), date3(7)
492  character string*40
493 c
494 
495  print *,'isolate'
496  call time_clear(date1)
497  date1(1)=2018
498  date1(2)=13
499  date1(3)=-23
500  date1(4)=0
501  call time_util_warning_report_time('norm bug test',date1)
502  call time_norm(date1)
503  call time_util_warning_report_time('norm bug test',date1)
504  call time_norm(date1)
505  call time_util_warning_report_time('norm bug test',date1)
506  return
507  end
508 
time_div
void time_div(time_Ts Date1, time_Ts *Pdate2, timeint n, timeint *rest)
Definition: ctime_div.c:36
time_sprint
char * time_sprint(time_Ts Date)
Definition: ctime_sprint.c:39
time_util_warning_report_time
subroutine time_util_warning_report_time(caller, date)
Definition: time_util_warning_report_time.f:31
normbugtest
subroutine normbugtest()
Definition: testlibtime.f:485
head
void head(char *routine)
Definition: ctlibtime.c:54
divmultest
void divmultest(time_Ts date1, long int n, time_Ts date2)
Definition: ctlibtime.c:91
time_add
void time_add(time_Ts Date1, time_Ts Date2, time_Ts *Pdate3)
Definition: ctime_add.c:33
subhead
void subhead(char *routine)
Definition: ctlibtime.c:60
time_getdate
void time_getdate(timeint *day, timeint *month, time_Ts Date)
Definition: ctime_getdate.c:36
testleap
subroutine testleap(year)
Definition: testlibtime.f:472
subaddtest
void subaddtest(time_Ts date1, time_Ts date2)
Definition: ctlibtime.c:36
time_libversion
double time_libversion()
Definition: ctime_libversion.c:32
time_setdoy
void time_setdoy(timeint day, timeint month, time_Ts *Pdate)
Definition: ctime_setdoy.c:36
time_clear
void time_clear(time_Ts *Pdate)
Definition: ctime_clear.c:33
time_copy
void time_copy(time_Ts Date1, time_Ts *Pdate2)
Definition: ctime_copy.c:33
testlibtime
program testlibtime
Definition: testlibtime.f:27
time_norm
void time_norm(time_Ts *Pdate)
Definition: ctime_norm.c:33
time_fullyear
void time_fullyear(timeint *year)
Definition: ctime_fullyear.c:35
time_sub
void time_sub(time_Ts Date1, time_Ts Date2, time_Ts *Pdate3)
Definition: ctime_sub.c:33
arout
void arout(time_Ts Date)
Definition: ctlibtime.c:66
time_nfit
void time_nfit(time_Ts Date1, time_Ts Date2, timeint *n, time_Ts *Pfull)
Definition: ctime_nfit.c:36
time_mul
void time_mul(time_Ts Date1, time_Ts *Pdate2, integer n)
Definition: ctime_mul.c:35
time_finish
void time_finish(time_Ts *Pdate)
Definition: ctime_finish.c:33
cmptest
void cmptest(time_Ts date1, time_Ts date2)
Definition: ctlibtime.c:77