1 | PROGRAM testcalendar |
---|
2 | !- |
---|
3 | !$Id: testcalendar.f90 386 2008-09-04 08:38:48Z bellier $ |
---|
4 | !- |
---|
5 | ! This software is governed by the CeCILL license |
---|
6 | ! See IOIPSL/IOIPSL_License_CeCILL.txt |
---|
7 | !--------------------------------------------------------------------- |
---|
8 | !- This program will do some basic tests on the calendar |
---|
9 | !--------------------------------------------------------------------- |
---|
10 | USE calendar |
---|
11 | !- |
---|
12 | IMPLICIT NONE |
---|
13 | !- |
---|
14 | REAL :: julian, sec |
---|
15 | INTEGER :: year, month, day |
---|
16 | INTEGER :: iread, iret |
---|
17 | CHARACTER(LEN=20) :: tmp |
---|
18 | !- |
---|
19 | INTEGER :: iargc, getarg |
---|
20 | EXTERNAL iargc, getarg |
---|
21 | !--------------------------------------------------------------------- |
---|
22 | !- |
---|
23 | ! Get the command line arguments |
---|
24 | !- |
---|
25 | iread = iargc() |
---|
26 | IF (iread .EQ. 0) THEN |
---|
27 | WRITE(*,*) 'Using the default calendar' |
---|
28 | ELSE |
---|
29 | iret = getarg(1,tmp) |
---|
30 | WRITE(*,*) 'Using the calendar named :',TRIM(tmp) |
---|
31 | CALL ioconf_calendar (TRIM(tmp)) |
---|
32 | ENDIF |
---|
33 | !- |
---|
34 | ! Get the origine of the julian days |
---|
35 | !- |
---|
36 | julian = 0.0 |
---|
37 | CALL ju2ymds (julian, year, month, day, sec) |
---|
38 | WRITE(*,*) 'Day at which the julian day was zero :' |
---|
39 | WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day |
---|
40 | !- |
---|
41 | ! Do we get the same day back when we go back and forth |
---|
42 | !- |
---|
43 | year = 1997 |
---|
44 | month = 8 |
---|
45 | day = 21 |
---|
46 | sec = 0.0 |
---|
47 | WRITE(*,*) 'Day transformed into julian :' |
---|
48 | WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day |
---|
49 | CALL ymds2ju (year, month, day, sec, julian) |
---|
50 | WRITE(*,*) ' --> The resulting julian day : ',julian |
---|
51 | CALL ju2ymds (julian, year, month, day, sec) |
---|
52 | WRITE(*,*) 'The day which comes out again :' |
---|
53 | WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day |
---|
54 | !- |
---|
55 | ! Yet another test but this time with a strange dat ! |
---|
56 | !- |
---|
57 | year = 1997 |
---|
58 | month = 3 |
---|
59 | day = 34 |
---|
60 | sec = 0.0 |
---|
61 | WRITE(*,*) 'Strange day transformed into julian :' |
---|
62 | WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day |
---|
63 | CALL ymds2ju (year, month, day, sec, julian) |
---|
64 | WRITE(*,*) ' --> The resulting julian day : ',julian |
---|
65 | CALL ju2ymds (julian, year, month, day, sec) |
---|
66 | WRITE(*,*) & |
---|
67 | & 'The day which comes out again, does it make more sense ? :' |
---|
68 | WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day |
---|
69 | !----------------------- |
---|
70 | END PROGRAM testcalendar |
---|