IOIPSL/Calendar/ju2ymds_internal.f

module ju2ymds_internal_m

  implicit none

contains

  SUBROUTINE ju2ymds_internal (julian_day, julian_sec, 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

    INTEGER, INTENT(IN):: julian_day
    REAL, INTENT(IN):: julian_sec

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

    INTEGER:: l, n, i, jd, j, d, m, y, ml
    INTEGER:: add_day
    !--------------------------------------------------------------------
    lock_unan = .TRUE.

    jd = julian_day
    sec = julian_sec
    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_internal

end module ju2ymds_internal_m
1	module ju2ymds_internal_m
2
3	implicit none
4
5	contains
6
7	SUBROUTINE ju2ymds_internal (julian_day, julian_sec, year, month, day, sec)
8
9	! This subroutine computes from the julian day the year,
10	! month, day and seconds
11
12	! 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
29
30	INTEGER, INTENT(IN):: julian_day
31	REAL, INTENT(IN):: julian_sec
32
33	INTEGER, INTENT(OUT):: year, month, day
34	REAL, INTENT(OUT):: sec
35
36	INTEGER:: l, n, i, jd, j, d, m, y, ml
37	INTEGER:: add_day
38	!--------------------------------------------------------------------
39	lock_unan = .TRUE.
40
41	jd = julian_day
42	sec = julian_sec
43	IF (sec > un_jour) THEN
44	add_day = INT(sec/un_jour)
45	sec = sec-add_day*un_jour
46	jd = jd+add_day
47	ENDIF
48
49	! Gregorian
50	IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN
51	jd = jd+2299160
52
53	l = jd+68569
54	n = (4*l)/146097
55	l = l-(146097*n+3)/4
56	i = (4000*(l+1))/1461001
57	l = l-(1461*i)/4+31
58	j = (80*l)/2447
59	d = l-(2447*j)/80
60	l = j/11
61	m = j+2-(12*l)
62	y = 100*(n-49)+i+l
63	! No leap or All leap
64	ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &
65	& ABS(un_an-366.0) <= EPSILON(un_an) ) THEN
66	y = jd/INT(un_an)
67	l = jd-y*INT(un_an)
68	m = 1
69	ml = 0
70	DO WHILE (ml+mon_len(m) <= l)
71	ml = ml+mon_len(m)
72	m = m+1
73	ENDDO
74	d = l-ml+1
75	! others
76	ELSE
77	ml = INT(un_an)/12
78	y = jd/INT(un_an)
79	l = jd-y*INT(un_an)
80	m = (l/ml)+1
81	d = l-(m-1)*ml+1
82	ENDIF
83
84	day = d
85	month = m
86	year = y
87
88	END SUBROUTINE ju2ymds_internal
89
90	end module ju2ymds_internal_m