The TELEMAC-MASCARET system  trunk
date_mjd2sec.f
Go to the documentation of this file.
1 ! **************************************
2  DOUBLE PRECISION FUNCTION date_mjd2sec
3 ! **************************************
4 !
5  &( date, time )
6 !
7 !***********************************************************************
8 ! TELEMAC2D V6P2 16/01/2012
9 !***********************************************************************
10 !
11 !brief CONVERTS DATE TO MJD (MODIFIED JULIAN DAYS)
12 !+ INPUT: ID - DAY, MM - MONTH, IYYY - YEAR
13 !+ HH - HOUR, MN - MINUTES, SS - SECONDS
14 !+ OUTPUT: MJD > 0 - MODIFIED JULIAN DAYS
15 !+ DATE >= 11.17.1858 CORRESPONDS TO MJD = 0
16 !
17 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
18 !| ID |<->| DATE (YEAR, MONTH, DAY)
19 !| TIME |<->| TIME (HOUR, MINUTE, SECOND)
20 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
21 !
23  IMPLICIT NONE
24 !
25 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
26 !
27  INTEGER, INTENT(IN) :: DATE(3), TIME(3)
28 !
29 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
30 !
31  INTEGER DPM(12),DAYS,I,NLEAP,K
32  parameter( dpm = (/ 31,28,31,30,31,30,31,31,30,31,30,31 /) )
33  INTEGER MM,ID,IYYY,HH,MN,SS
34 !
35 !-----------------------------------------------------------------------
36 !
37  iyyy = date(1)
38  mm = date(2)
39  id = date(3)
40  hh = time(1)
41  mn = time(2)
42  ss = time(3)
43 
44  date_mjd2sec = 0
45 ! NO EARLIER DATES THAN NOVEMBER 17TH 1858
46  IF( iyyy.LT.1858.OR.(iyyy.EQ.1858.AND.mm.LT.11)
47  & .OR.(iyyy.EQ.1858.AND.mm.EQ.11.AND.id.LT.17) ) THEN
48  WRITE(lu,*) 'NO EARLIER DATES ' //
49  & 'THAN NOVEMBER 17TH 1858 ARE ALLOWED'
50  CALL plante(1)
51  stop
52  ENDIF
53 !
54  days = 0
55  DO i = 1,mm-1
56  days = days+dpm(i)
57  IF( i.EQ.2.AND.int(iyyy/4)*4.EQ.iyyy ) days = days+1
58  ENDDO
59 ! 321TH DAY CORRESPONDS TO NOVEMBER 17TH FOR A NON LEAP YEAR
60  days = days+id-321
61 
62 ! LEAP DAY CORRECTION
63  DO k = 1900,iyyy,100
64  IF( k.EQ.iyyy.AND.mm.GT.2 ) days = days-1
65  ENDDO
66  DO k = 2000,iyyy,400
67  IF( k.EQ.iyyy.AND.mm.GT.2 ) days = days+1
68  ENDDO
69 ! EACH 4TH YEAR IS LEAP YEAR
70  nleap = int(REAL(iyyy-1-1860)*0.25)
71  IF( iyyy.GT.1860 ) nleap = nleap+1
72 ! EXCEPT
73  DO k = 1900,iyyy-1,100
74  IF( k.LT.iyyy ) nleap = nleap-1
75 ! THE FOLLOWING LINE IS USELESS AS K.GE.IYYY-1
76 ! IF( K.EQ.IYYY.AND.MM.GT.2 ) DAYS = DAYS-1
77  ENDDO
78 ! BUT EACH IN THE ROW 2000:400:... IS LEAP YEAR AGAIN
79  DO k = 2000,iyyy-1,400
80  IF( k.LT.iyyy ) nleap = nleap+1
81 ! THE FOLLOWING LINE IS USELESS AS K.GE.IYYY-1
82 ! IF( K.EQ.IYYY.AND.MM.GT.2 ) DAYS = DAYS+1
83  ENDDO
84  date_mjd2sec = (365.0*(iyyy-1858.0)+nleap+days)*86400.0+
85  & hh*3600.0+mn*60.0+ss
86 !
87 !-----------------------------------------------------------------------
88 !
89  RETURN
90  END FUNCTION date_mjd2sec
double precision function date_mjd2sec(DATE, TIME)
Definition: date_mjd2sec.f:7