IOIPSL/Calendar/ju2ymds.f

module ju2ymds_m

  implicit none

contains

  SUBROUTINE ju2ymds (julian, year, month, day, sec)

    ! This subroutine computes from the julian day the year,
    ! month, day and seconds

    ! In 1968 in a letter to the editor of Communications of the ACM
    ! (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
    ! and Thomas C. Van Flandern presented such an algorithm.

    ! See also: http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm

    ! In the case of the Gregorian calendar we have chosen to use
    ! the Lilian day numbers. This is the day counter which starts
    ! on the 15th October 1582. This is the day at which Pope
    ! Gregory XIII introduced the Gregorian calendar.
    ! Compared to the true Julian calendar, which starts some 7980
    ! years ago, the Lilian days are smaler and are dealt with easily
    ! on 32 bit machines. With the true Julian days you can only the
    ! fraction of the day in the real part to a precision of a 1/4 of
    ! a day with 32 bits.

    use calendar, only: un_jour, lock_unan
    use ioconf_calendar_m, only: mon_len, un_an

    REAL, INTENT(IN):: julian
    INTEGER, INTENT(OUT):: year, month, day
    REAL, INTENT(OUT):: sec

    ! Local:
    INTEGER:: l, n, i, jd, j, d, m, y, ml
    INTEGER:: add_day

    !--------------------------------------------------------------------

    jd = INT(julian)
    sec = (julian - jd) * un_jour

    lock_unan = .TRUE.

    IF (sec > un_jour) THEN
       add_day = INT(sec / un_jour)
       sec = sec - add_day * un_jour
       jd = jd+add_day
    ENDIF

    ! Gregorian
    IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN
       jd = jd+2299160

       l = jd+68569
       n = (4*l)/146097
       l = l-(146097*n+3)/4
       i = (4000*(l+1))/1461001
       l = l-(1461*i)/4+31
       j = (80*l)/2447
       d = l-(2447*j)/80
       l = j/11
       m = j+2-(12*l)
       y = 100*(n-49)+i+l
       ! No leap or All leap
    ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &
         &   ABS(un_an-366.0) <= EPSILON(un_an) ) THEN
       y = jd/INT(un_an)
       l = jd-y*INT(un_an)
       m = 1
       ml = 0
       DO WHILE (ml+mon_len(m) <= l)
          ml = ml+mon_len(m)
          m = m+1
       ENDDO
       d = l-ml+1
       ! others
    ELSE
       ml = INT(un_an)/12
       y = jd/INT(un_an)
       l = jd-y*INT(un_an)
       m = (l/ml)+1
       d = l-(m-1)*ml+1
    ENDIF

    day = d
    month = m
    year = y

  END SUBROUTINE ju2ymds

end module ju2ymds_m
1	guez	92	module ju2ymds_m
2
3			implicit none
4
5			contains
6
7			SUBROUTINE ju2ymds (julian, year, month, day, sec)
8
9	guez	93	! This subroutine computes from the julian day the year,
10			! month, day and seconds
11	guez	92
12	guez	93	! In 1968 in a letter to the editor of Communications of the ACM
13			! (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
14			! and Thomas C. Van Flandern presented such an algorithm.
15
16			! See also: http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
17
18			! In the case of the Gregorian calendar we have chosen to use
19			! the Lilian day numbers. This is the day counter which starts
20			! on the 15th October 1582. This is the day at which Pope
21			! Gregory XIII introduced the Gregorian calendar.
22			! Compared to the true Julian calendar, which starts some 7980
23			! years ago, the Lilian days are smaler and are dealt with easily
24			! on 32 bit machines. With the true Julian days you can only the
25			! fraction of the day in the real part to a precision of a 1/4 of
26			! a day with 32 bits.
27
28			use calendar, only: un_jour, lock_unan
29			use ioconf_calendar_m, only: mon_len, un_an
30
31	guez	92	REAL, INTENT(IN):: julian
32			INTEGER, INTENT(OUT):: year, month, day
33			REAL, INTENT(OUT):: sec
34
35	guez	93	! Local:
36			INTEGER:: l, n, i, jd, j, d, m, y, ml
37			INTEGER:: add_day
38
39	guez	92	!--------------------------------------------------------------------
40
41	guez	93	jd = INT(julian)
42			sec = (julian - jd) * un_jour
43	guez	92
44	guez	93	lock_unan = .TRUE.
45
46			IF (sec > un_jour) THEN
47			add_day = INT(sec / un_jour)
48			sec = sec - add_day * un_jour
49			jd = jd+add_day
50			ENDIF
51
52			! Gregorian
53			IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN
54			jd = jd+2299160
55
56			l = jd+68569
57			n = (4*l)/146097
58			l = l-(146097*n+3)/4
59			i = (4000*(l+1))/1461001
60			l = l-(1461*i)/4+31
61			j = (80*l)/2447
62			d = l-(2447*j)/80
63			l = j/11
64			m = j+2-(12*l)
65			y = 100*(n-49)+i+l
66			! No leap or All leap
67			ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &
68			& ABS(un_an-366.0) <= EPSILON(un_an) ) THEN
69			y = jd/INT(un_an)
70			l = jd-y*INT(un_an)
71			m = 1
72			ml = 0
73			DO WHILE (ml+mon_len(m) <= l)
74			ml = ml+mon_len(m)
75			m = m+1
76			ENDDO
77			d = l-ml+1
78			! others
79			ELSE
80			ml = INT(un_an)/12
81			y = jd/INT(un_an)
82			l = jd-y*INT(un_an)
83			m = (l/ml)+1
84			d = l-(m-1)*ml+1
85			ENDIF
86
87			day = d
88			month = m
89			year = y
90
91	guez	92	END SUBROUTINE ju2ymds
92
93			end module ju2ymds_m