1 | RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, & |
---|
2 | & prelday, krefdate ) |
---|
3 | !!----------------------------------------------------------------------- |
---|
4 | !! |
---|
5 | !! *** ROUTINE jul2greg *** |
---|
6 | !! |
---|
7 | !! ** Purpose : Take the relative time in days and re-express in terms of |
---|
8 | !! seconds, minutes, hours, days, month, year. |
---|
9 | !! |
---|
10 | !! ** Method : Reference date : 19500101 |
---|
11 | !! |
---|
12 | !! ** Action : |
---|
13 | !! |
---|
14 | !! History |
---|
15 | !! ! 06-04 (A. Vidard) Original |
---|
16 | !! ! 06-05 (A. Vidard) Reformatted and refdate |
---|
17 | !! ! 06-10 (A. Weaver) Cleanup |
---|
18 | !! ! 2014-09 (D. Lea) Change to use FLOOR to deal with negative prelday |
---|
19 | !!----------------------------------------------------------------------- |
---|
20 | |
---|
21 | ! * Arguments |
---|
22 | INTEGER, INTENT(IN), OPTIONAL :: & |
---|
23 | & krefdate |
---|
24 | INTEGER, INTENT(OUT) :: & |
---|
25 | & ksec, & |
---|
26 | & kminut, & |
---|
27 | & khour, & |
---|
28 | & kday, & |
---|
29 | & kmonth, & |
---|
30 | & kyear |
---|
31 | REAL(KIND=dp), INTENT(IN) :: & |
---|
32 | & prelday |
---|
33 | |
---|
34 | !! * Local declarations |
---|
35 | INTEGER, PARAMETER :: & |
---|
36 | & jpgreg = 2299161, & |
---|
37 | & jporef = 2433283, & |
---|
38 | & jparef = 2415021 |
---|
39 | INTEGER :: & |
---|
40 | & ijulian, & |
---|
41 | & ij1, & |
---|
42 | & ija, & |
---|
43 | & ijb, & |
---|
44 | & ijc, & |
---|
45 | & ijd, & |
---|
46 | & ije, & |
---|
47 | & isec, & |
---|
48 | & imin, & |
---|
49 | & ihou, & |
---|
50 | & iday, & |
---|
51 | & imon, & |
---|
52 | & iyea, & |
---|
53 | & iref |
---|
54 | REAL(KIND=wp) :: & |
---|
55 | & zday, & |
---|
56 | & zref |
---|
57 | CHARACTER(len=200) :: & |
---|
58 | & cerr |
---|
59 | |
---|
60 | ! Main computation |
---|
61 | IF ( PRESENT( krefdate ) ) THEN |
---|
62 | |
---|
63 | SELECT CASE ( krefdate ) |
---|
64 | |
---|
65 | CASE( 0 ) |
---|
66 | iref = jpgreg |
---|
67 | |
---|
68 | CASE( 19500101 ) |
---|
69 | iref = jporef |
---|
70 | |
---|
71 | CASE( 19000101 ) |
---|
72 | iref = jparef |
---|
73 | |
---|
74 | CASE DEFAULT |
---|
75 | WRITE(cerr,'(A,I8.8)')'jul2greg: Unknown krefdate:', krefdate |
---|
76 | CALL ctl_stop( cerr ) |
---|
77 | |
---|
78 | END SELECT |
---|
79 | |
---|
80 | ELSE |
---|
81 | iref = jporef |
---|
82 | ENDIF |
---|
83 | |
---|
84 | zday = prelday |
---|
85 | ksec = FLOOR( 86400. * MOD( zday, 1. ) ) |
---|
86 | |
---|
87 | IF ( ksec < 0. ) ksec = 86400. + ksec |
---|
88 | |
---|
89 | khour = ksec / 3600 |
---|
90 | kminut = ( ksec - 3600 * khour ) / 60 |
---|
91 | ksec = MOD( ksec , 60 ) |
---|
92 | |
---|
93 | ijulian = iref + INT( zday ) |
---|
94 | IF ( zday < 0. ) ijulian = ijulian - 1 |
---|
95 | |
---|
96 | ! If input date after 10/15/1582 : |
---|
97 | IF ( ijulian >= jpgreg ) THEN |
---|
98 | ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 ) |
---|
99 | ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) ) |
---|
100 | ELSE |
---|
101 | ija = ijulian |
---|
102 | ENDIF |
---|
103 | |
---|
104 | ijb = ija + 1524 |
---|
105 | ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 ) |
---|
106 | ijd = 365 * ijc + INT( 0.25 * ijc ) |
---|
107 | ije = INT( ( ijb - ijd ) / 30.6001 ) |
---|
108 | kday = ijb - ijd - INT( 30.6001 * ije ) |
---|
109 | kmonth = ije - 1 |
---|
110 | IF ( kmonth > 12 ) kmonth = kmonth - 12 |
---|
111 | kyear = ijc - 4715 |
---|
112 | IF ( kmonth > 2 ) kyear = kyear - 1 |
---|
113 | IF ( kyear <= 0 ) kyear = kyear - 1 |
---|
114 | |
---|
115 | END SUBROUTINE jul2greg |
---|