IOIPSL/Calendar/ju2ymds.f90

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
    ! smaller and are dealt with easily on 32 bit machines. With the
    ! true Julian days you can only compute 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

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

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

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

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

    lock_unan = .TRUE.

    ! 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	module ju2ymds_m
2
3	implicit none
4
5	contains
6
7	SUBROUTINE ju2ymds(julian, 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 the
19	! Lilian day numbers. This is the day counter which starts on the
20	! 15th October 1582. This is the day at which Pope Gregory XIII
21	! introduced the Gregorian calendar. Compared to the true Julian
22	! calendar, which starts some 7980 years ago, the Lilian days are
23	! smaller and are dealt with easily on 32 bit machines. With the
24	! true Julian days you can only compute the fraction of the day in
25	! the real part to a precision of a 1/4 of a day with 32 bits.
26
27	use calendar, only: un_jour, lock_unan
28	use ioconf_calendar_m, only: mon_len, un_an
29
30	double precision, INTENT(IN):: julian
31	INTEGER, INTENT(OUT):: year, month, day
32	REAL, INTENT(OUT), optional:: sec
33
34	! Local:
35	INTEGER l, n, i, jd, j, d, m, y, ml
36
37	!--------------------------------------------------------------------
38
39	jd = INT(julian)
40	if (present(sec)) sec = (julian - jd) * un_jour
41
42	lock_unan = .TRUE.
43
44	! Gregorian
45	IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN
46	jd = jd+2299160
47
48	l = jd+68569
49	n = (4*l)/146097
50	l = l-(146097*n+3)/4
51	i = (4000*(l+1))/1461001
52	l = l-(1461*i)/4+31
53	j = (80*l)/2447
54	d = l-(2447*j)/80
55	l = j/11
56	m = j+2-(12*l)
57	y = 100*(n-49)+i+l
58	! No leap or All leap
59	ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &
60	& ABS(un_an-366.0) <= EPSILON(un_an) ) THEN
61	y = jd/INT(un_an)
62	l = jd-y*INT(un_an)
63	m = 1
64	ml = 0
65	DO WHILE (ml+mon_len(m) <= l)
66	ml = ml+mon_len(m)
67	m = m+1
68	ENDDO
69	d = l-ml+1
70	! others
71	ELSE
72	ml = INT(un_an)/12
73	y = jd/INT(un_an)
74	l = jd-y*INT(un_an)
75	m = (l/ml)+1
76	d = l-(m-1)*ml+1
77	ENDIF
78
79	day = d
80	month = m
81	year = y
82
83	END SUBROUTINE ju2ymds
84
85	end module ju2ymds_m