[1895] | 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 |
---|