/[lmdze]/trunk/IOIPSL/Calendar/calendar.f
ViewVC logotype

Diff of /trunk/IOIPSL/Calendar/calendar.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/IOIPSL/calendar.f90 revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC trunk/IOIPSL/calendar.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 1  Line 1 
1  MODULE calendar  MODULE calendar
2    !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/calendar.f90,v 2.0 2004/04/05 14:47:47 adm Exp $  
3    !-    ! From IOIPSL/src/calendar.f90, version 2.0 2004/04/05 14:47:47
4    !---------------------------------------------------------------------  
5    !- This is the calendar which going to be used to do all    ! This is the calendar used to do all calculations on time. Three
6    !- calculations on time. Three types of calendars are possible :    ! types of calendars are possible:
7    !-  - gregorian : The normal calendar. The time origin for the  
8    !-                julian day in this case is 24 Nov -4713    ! - Gregorian:
9    !-  - nolap : A 365 day year without leap years.    ! The normal calendar. The time origin for the julian day in this
10    !-            The origin for the julian days is in this case 1 Jan 0    ! case is 24 Nov -4713.
11    !-  - xxxd : Year of xxx days with month of equal length.  
12    !-           The origin for the julian days is then also 1 Jan 0    ! - No leap:
13    !- As one can see it is difficult to go from one calendar to the other.    ! A 365 day year without leap years. The origin for the julian days
14    !- All operations involving julian days will be wrong.    ! is in this case 1 Jan 0.
15    !- This calendar will lock as soon as possible  
16    !- the length of the year and  forbid any further modification.    ! - xxxd:
17    !-    ! Year of xxx days with months of equal length. The origin for the
18    !- For the non leap-year calendar the method is still brute force.    ! julian days is then also 1 Jan 0.
19    !- We need to find an Integer series which takes care of the length  
20    !- of the various month. (Jan)    ! As one can see it is difficult to go from one calendar to the
21    !-    ! other. All operations involving julian days will be wrong. This
22    !-   un_jour : one day in seconds    ! calendar will lock as soon as possible the length of the year and
23    !-   un_an   : one year in days    ! forbid any further modification.
24    !---------------------------------------------------------------------  
25    USE stringop, ONLY : strlowercase    ! For the non leap-year calendar the method is still brute force.
26    USE errioipsl, ONLY : histerr    ! We need to find an integer series which takes care of the length
27    !-    ! of the various month. (Jan)
28    
29      USE strlowercase_m, ONLY: strlowercase
30      USE errioipsl, ONLY: histerr
31    
32      IMPLICIT NONE
33    
34    PRIVATE    PRIVATE
35    PUBLIC :: ymds2ju,ju2ymds,tlen2itau,isittime,ioconf_calendar, &    PUBLIC ymds2ju, ju2ymds, isittime, ioconf_calendar, itau2date, lock_unan, &
36         &          ioget_calendar,itau2date,ioget_timestamp, &         calendar_used, un_an, un_jour
37         &          ioconf_startdate,itau2ymds,time_diff,time_add  
38    !-    REAL, PARAMETER:: un_jour = 86400. ! one day in seconds
39    INTERFACE ioget_calendar  
40       MODULE PROCEDURE &    ! Description of calendar
41            &    ioget_calendar_real1,ioget_calendar_real2,ioget_calendar_str  
42    END INTERFACE    CHARACTER(LEN=20):: calendar_used = "gregorian"
43    !-    LOGICAL:: lock_unan = .FALSE.
44    INTERFACE ioconf_startdate    REAL:: un_an = 365.2425 ! one year in days
45       MODULE PROCEDURE &    INTEGER:: mon_len(12) = (/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
46            &    ioconf_startdate_simple,ioconf_startdate_internal, &  
47            &    ioconf_startdate_ymds    CHARACTER(LEN=3), PARAMETER:: cal(12) = (/'JAN', 'FEB', 'MAR', 'APR', &
48    END INTERFACE         'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/)
49    !-  
50    REAL,PARAMETER :: un_jour = 86400.0    REAL, SAVE:: start_day, start_sec
   LOGICAL,SAVE :: lock_startdate = .FALSE.  
   !-  
   CHARACTER(LEN=30),SAVE :: time_stamp='XXXXXXXXXXXXXXXX'  
   !-  
   !- Description of calendar  
   !-  
   CHARACTER(LEN=20),SAVE :: calendar_used="gregorian"  
   LOGICAL,SAVE :: lock_unan = .FALSE.  
   REAL,SAVE :: un_an = 365.2425  
   INTEGER,SAVE :: mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)  
   !-  
   !-  
   !-  
   CHARACTER(LEN=3),PARAMETER :: &  
        &  cal(12) = (/'JAN','FEB','MAR','APR','MAY','JUN', &  
        &              'JUL','AUG','SEP','OCT','NOV','DEC'/)  
   !-  
   REAL,SAVE :: start_day,start_sec  
51    
52  CONTAINS  CONTAINS
53    
54    SUBROUTINE ymds2ju (year,month,day,sec,julian)    SUBROUTINE ymds2ju (year, month, day, sec, julian)
55    
56      IMPLICIT NONE      INTEGER, INTENT(IN):: year, month, day
57        REAL, INTENT(IN):: sec
58        REAL, INTENT(OUT):: julian
59    
60      INTEGER,INTENT(IN) :: year,month,day      INTEGER:: julian_day
61      REAL,INTENT(IN)    :: sec      REAL:: julian_sec
62    
63      REAL,INTENT(OUT) :: julian      !--------------------------------------------------------------------
64    
65      INTEGER :: julian_day      CALL ymds2ju_internal(year, month, day, sec, julian_day, julian_sec)
66      REAL    :: julian_sec      julian = julian_day + julian_sec / un_jour
     !---------------------------------------------------------------------  
     CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)  
67    
     julian = julian_day+julian_sec / un_jour  
     !---------------------  
68    END SUBROUTINE ymds2ju    END SUBROUTINE ymds2ju
69    
70    !===    !===
71    
72    SUBROUTINE ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)    SUBROUTINE ymds2ju_internal (year, month, day, sec, julian_day, julian_sec)
     !---------------------------------------------------------------------  
     !- Converts year, month, day and seconds into a julian day  
   
     !- 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.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
73    
74      INTEGER,INTENT(IN) :: year,month,day      ! Converts year, month, day and seconds into a julian day
     REAL,INTENT(IN)    :: sec  
75    
76      INTEGER,INTENT(OUT) :: julian_day      ! In 1968 in a letter to the editor of Communications of the ACM
77      REAL,INTENT(OUT)    :: julian_sec      ! (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
78        ! and Thomas C. Van Flandern presented such an algorithm.
79    
80        ! See also: http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
81    
82        ! In the case of the Gregorian calendar we have chosen to use
83        ! the Lilian day numbers. This is the day counter which starts
84        ! on the 15th October 1582.
85        ! This is the day at which Pope Gregory XIII introduced the
86        ! Gregorian calendar.
87        ! Compared to the true Julian calendar, which starts some
88        ! 7980 years ago, the Lilian days are smaler and are dealt with
89        ! easily on 32 bit machines. With the true Julian days you can only
90        ! the fraction of the day in the real part to a precision of
91        ! a 1/4 of a day with 32 bits.
92    
93      INTEGER :: jd,m,y,d,ml      INTEGER, INTENT(IN):: year, month, day
94      !---------------------------------------------------------------------      REAL, INTENT(IN):: sec
95    
96        INTEGER, INTENT(OUT):: julian_day
97        REAL, INTENT(OUT):: julian_sec
98    
99        INTEGER:: jd, m, y, d, ml
100        !--------------------------------------------------------------------
101      lock_unan = .TRUE.      lock_unan = .TRUE.
102    
103      m = month      m = month
104      y = year      y = year
105      d = day      d = day
106    
107      !- We deduce the calendar from the length of the year as it      ! We deduce the calendar from the length of the year as it
108      !- is faster than an INDEX on the calendar variable.      ! is faster than an INDEX on the calendar variable.
109    
110      !- Gregorian      ! Gregorian
111      IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN      IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN
112         jd = (1461*(y+4800+INT(( m-14 )/12)))/4 &         jd = (1461*(y+4800+INT(( m-14 )/12)))/4 &
113              &      +(367*(m-2-12*(INT(( m-14 )/12))))/12 &              &      +(367*(m-2-12*(INT(( m-14 )/12))))/12 &
114              &      -(3*((y+4900+INT((m-14)/12))/100))/4 &              &      -(3*((y+4900+INT((m-14)/12))/100))/4 &
115              &      +d-32075              &      +d-32075
116         jd = jd-2299160         jd = jd-2299160
117         !- No leap or All leap         ! No leap or All leap
118      ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &      ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &
119           &   ABS(un_an-366.0) <= EPSILON(un_an)) THEN           &   ABS(un_an-366.0) <= EPSILON(un_an)) THEN
120         ml = SUM(mon_len(1:m-1))         ml = SUM(mon_len(1:m-1))
121         jd = y*INT(un_an)+ml+(d-1)         jd = y*INT(un_an)+ml+(d-1)
122         !- Calendar with regular month         ! Calendar with regular month
123      ELSE      ELSE
124         ml = INT(un_an)/12         ml = INT(un_an)/12
125         jd = y*INT(un_an)+(m-1)*ml+(d-1)         jd = y*INT(un_an)+(m-1)*ml+(d-1)
# Line 143  CONTAINS Line 127  CONTAINS
127    
128      julian_day = jd      julian_day = jd
129      julian_sec = sec      julian_sec = sec
130      !------------------------------  
131    END SUBROUTINE ymds2ju_internal    END SUBROUTINE ymds2ju_internal
132    !-  
133    !===    !===
134    !-  
135    SUBROUTINE ju2ymds (julian,year,month,day,sec)    SUBROUTINE ju2ymds (julian, year, month, day, sec)
136      !---------------------------------------------------------------------  
137      IMPLICIT NONE      REAL, INTENT(IN):: julian
138    
139      REAL,INTENT(IN) :: julian      INTEGER, INTENT(OUT):: year, month, day
140        REAL, INTENT(OUT):: sec
141      INTEGER,INTENT(OUT) :: year,month,day  
142      REAL,INTENT(OUT)    :: sec      INTEGER:: julian_day
143        REAL:: julian_sec
144      INTEGER :: julian_day      !--------------------------------------------------------------------
     REAL    :: julian_sec  
     !---------------------------------------------------------------------  
145      julian_day = INT(julian)      julian_day = INT(julian)
146      julian_sec = (julian-julian_day)*un_jour      julian_sec = (julian-julian_day)*un_jour
147    
148      CALL ju2ymds_internal(julian_day,julian_sec,year,month,day,sec)      CALL ju2ymds_internal(julian_day, julian_sec, year, month, day, sec)
149      !---------------------  
150    END SUBROUTINE ju2ymds    END SUBROUTINE ju2ymds
151    !-  
152    !===    !===
153    !-  
154    SUBROUTINE ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)    SUBROUTINE ju2ymds_internal (julian_day, julian_sec, year, month, day, sec)
155      !---------------------------------------------------------------------  
156      !- This subroutine computes from the julian day the year,      ! This subroutine computes from the julian day the year,
157      !- month, day and seconds      ! month, day and seconds
158    
159      !- In 1968 in a letter to the editor of Communications of the ACM      ! In 1968 in a letter to the editor of Communications of the ACM
160      !- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel      ! (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
161      !- and Thomas C. Van Flandern presented such an algorithm.      ! and Thomas C. Van Flandern presented such an algorithm.
162    
163      !- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm      ! See also: http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
164    
165      !- In the case of the Gregorian calendar we have chosen to use      ! In the case of the Gregorian calendar we have chosen to use
166      !- the Lilian day numbers. This is the day counter which starts      ! the Lilian day numbers. This is the day counter which starts
167      !- on the 15th October 1582. This is the day at which Pope      ! on the 15th October 1582. This is the day at which Pope
168      !- Gregory XIII introduced the Gregorian calendar.      ! Gregory XIII introduced the Gregorian calendar.
169      !- Compared to the true Julian calendar, which starts some 7980      ! Compared to the true Julian calendar, which starts some 7980
170      !- years ago, the Lilian days are smaler and are dealt with easily      ! years ago, the Lilian days are smaler and are dealt with easily
171      !- on 32 bit machines. With the true Julian days you can only the      ! on 32 bit machines. With the true Julian days you can only the
172      !- fraction of the day in the real part to a precision of a 1/4 of      ! fraction of the day in the real part to a precision of a 1/4 of
173      !- a day with 32 bits.      ! a day with 32 bits.
174      !---------------------------------------------------------------------  
175      IMPLICIT NONE      INTEGER, INTENT(IN):: julian_day
176        REAL, INTENT(IN):: julian_sec
177      INTEGER,INTENT(IN) :: julian_day  
178      REAL,INTENT(IN)    :: julian_sec      INTEGER, INTENT(OUT):: year, month, day
179        REAL, INTENT(OUT):: sec
180      INTEGER,INTENT(OUT) :: year,month,day  
181      REAL,INTENT(OUT)    :: sec      INTEGER:: l, n, i, jd, j, d, m, y, ml
182        INTEGER:: add_day
183      INTEGER :: l,n,i,jd,j,d,m,y,ml      !--------------------------------------------------------------------
     INTEGER :: add_day  
     !---------------------------------------------------------------------  
184      lock_unan = .TRUE.      lock_unan = .TRUE.
185    
186      jd = julian_day      jd = julian_day
# Line 211  CONTAINS Line 191  CONTAINS
191         jd = jd+add_day         jd = jd+add_day
192      ENDIF      ENDIF
193    
194      !- Gregorian      ! Gregorian
195      IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN      IF ( (un_an > 365.0).AND.(un_an < 366.0) ) THEN
196         jd = jd+2299160         jd = jd+2299160
197        
# Line 225  CONTAINS Line 205  CONTAINS
205         l = j/11         l = j/11
206         m = j+2-(12*l)         m = j+2-(12*l)
207         y = 100*(n-49)+i+l         y = 100*(n-49)+i+l
208         !- No leap or All leap         ! No leap or All leap
209      ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &      ELSE IF (ABS(un_an-365.0) <= EPSILON(un_an) .OR. &
210           &   ABS(un_an-366.0) <= EPSILON(un_an) ) THEN           &   ABS(un_an-366.0) <= EPSILON(un_an) ) THEN
211         y = jd/INT(un_an)         y = jd/INT(un_an)
# Line 237  CONTAINS Line 217  CONTAINS
217            m = m+1            m = m+1
218         ENDDO         ENDDO
219         d = l-ml+1         d = l-ml+1
220         !- others         ! others
221      ELSE      ELSE
222         ml = INT(un_an)/12         ml = INT(un_an)/12
223         y = jd/INT(un_an)         y = jd/INT(un_an)
# Line 249  CONTAINS Line 229  CONTAINS
229      day = d      day = d
230      month = m      month = m
231      year = y      year = y
232      !------------------------------  
233    END SUBROUTINE ju2ymds_internal    END SUBROUTINE ju2ymds_internal
234    !-  
   !===  
   !-  
   SUBROUTINE tlen2itau (input_str,dt,date,itau)  
     !---------------------------------------------------------------------  
     !- This subroutine transforms a sting containing a time length  
     !- into a number of time steps.  
     !- To do this operation the date (in julian days is needed as the  
     !- length of the month varies.  
     !- The following convention is used :  
     !-   n   : n time steps  
     !-   nS  : n seconds is transformed into itaus  
     !-   nH  : n hours  
     !-   nD  : n days  
     !-   nM  : n month  
     !-   nY  : n years  
     !- Combinations are also possible  
     !-   nYmD : nyears plus m days !  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     CHARACTER(LEN=*),INTENT(IN) :: input_str  
     REAL,INTENT(IN)             :: dt,date  
   
     INTEGER,INTENT(OUT)         :: itau  
   
     INTEGER           :: y_pos,m_pos,d_pos,h_pos,s_pos  
     INTEGER           :: read_time  
     CHARACTER(LEN=13) :: fmt  
     CHARACTER(LEN=80) :: tmp_str  
   
     INTEGER :: year,month,day  
     REAL    :: sec,date_new,dd,ss  
     !---------------------------------------------------------------------  
     itau = 0  
     CALL ju2ymds (date,year,month,day,sec)  
   
     y_pos = MAX(INDEX(input_str,'y'),INDEX(input_str,'Y'))  
     m_pos = MAX(INDEX(input_str,'m'),INDEX(input_str,'M'))  
     d_pos = MAX(INDEX(input_str,'d'),INDEX(input_str,'D'))  
     h_pos = MAX(INDEX(input_str,'h'),INDEX(input_str,'H'))  
     s_pos = MAX(INDEX(input_str,'s'),INDEX(input_str,'S'))  
   
     IF (MAX(y_pos,m_pos,d_pos,s_pos) > 0) THEN  
        tmp_str = input_str  
        DO WHILE ( MAX(y_pos,m_pos,d_pos,s_pos) > 0)  
           !---- WRITE(*,*) tmp_str  
           !---- WRITE(*,*) y_pos,m_pos,d_pos,s_pos  
           IF (y_pos > 0) THEN  
              WRITE(fmt,'("(I",I10.10,")")') y_pos-1  
              READ(tmp_str(1:y_pos-1),fmt) read_time  
              CALL ymds2ju (year+read_time,month,day,sec,date_new)  
              dd = date_new-date  
              ss = INT(dd)*un_jour+dd-INT(dd)  
              itau = itau+NINT(ss/dt)  
              tmp_str = tmp_str(y_pos+1:LEN_TRIM(tmp_str))  
           ELSE IF (m_pos > 0) THEN  
              WRITE(fmt,'("(I",I10.10,")")') m_pos-1  
              READ(tmp_str(1:m_pos-1),fmt) read_time  
              CALL ymds2ju (year,month+read_time,day,sec,date_new)  
              dd = date_new-date  
              ss = INT(dd)*un_jour+ dd-INT(dd)  
              itau = itau+NINT(ss/dt)  
              tmp_str = tmp_str(m_pos+1:LEN_TRIM(tmp_str))  
           ELSE IF (d_pos > 0) THEN  
              WRITE(fmt,'("(I",I10.10,")")') d_pos-1  
              READ(tmp_str(1:d_pos-1),fmt) read_time  
              itau = itau+NINT(read_time*un_jour/dt)  
              tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))  
           ELSE IF (h_pos > 0) THEN  
              WRITE(fmt,'("(I",I10.10,")")') h_pos-1  
              READ(tmp_str(1:h_pos-1),fmt) read_time  
              itau = itau+NINT(read_time*60.*60./dt)  
              tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))  
           ELSE IF  (s_pos > 0) THEN  
              WRITE(fmt,'("(I",I10.10,")")') s_pos-1  
              READ(tmp_str(1:s_pos-1),fmt) read_time  
              itau = itau+NINT(read_time/dt)  
              tmp_str = tmp_str(s_pos+1:LEN_TRIM(tmp_str))  
           ENDIF  
         
           y_pos = MAX(INDEX(tmp_str,'y'),INDEX(tmp_str,'Y'))  
           m_pos = MAX(INDEX(tmp_str,'m'),INDEX(tmp_str,'M'))  
           d_pos = MAX(INDEX(tmp_str,'d'),INDEX(tmp_str,'D'))  
           h_pos = MAX(INDEX(tmp_str,'h'),INDEX(tmp_str,'H'))  
           s_pos = MAX(INDEX(tmp_str,'s'),INDEX(tmp_str,'S'))  
        ENDDO  
     ELSE  
        WRITE(fmt,'("(I",I10.10,")")') LEN_TRIM(input_str)  
        READ(input_str(1:LEN_TRIM(input_str)),fmt) itau  
     ENDIF  
     !-----------------------  
   END SUBROUTINE tlen2itau  
   !-  
235    !===    !===
236    !-  
237    REAL FUNCTION itau2date (itau,date0,deltat)    REAL FUNCTION itau2date (itau, date0, deltat)
238      !---------------------------------------------------------------------  
239      !- This function transforms itau into a date. The date whith which      ! This function transforms itau into a date. The date whith which
240      !- the time axis is going to be labeled      ! the time axis is going to be labeled
241    
242      !- INPUT      ! INPUT
243      !-   itau   : current time step      !   itau: current time step
244      !-   date0  : Date at which itau was equal to 0      !   date0: Date at which itau was equal to 0
245      !-   deltat : time step between itau s      !   deltat: time step between itau s
246    
247      !- OUTPUT      ! OUTPUT
248      !-   itau2date : Date for the given itau      !   itau2date: Date for the given itau
249      !---------------------------------------------------------------------  
250      IMPLICIT NONE      INTEGER:: itau
251        REAL:: date0, deltat
252      INTEGER  :: itau      !--------------------------------------------------------------------
     REAL     :: date0,deltat  
     !---------------------------------------------------------------------  
253      itau2date = REAL(itau)*deltat/un_jour+date0      itau2date = REAL(itau)*deltat/un_jour+date0
254      !---------------------  
255    END FUNCTION itau2date    END FUNCTION itau2date
256    !-  
   !===  
   !-  
   SUBROUTINE itau2ymds (itau,deltat,year,month,date,sec)  
     !---------------------------------------------------------------------  
     !- This subroutine transforms itau into a date. The date whith which  
     !- the time axis is going to be labeled  
   
     !- INPUT  
     !-   itau   : current time step  
     !-   deltat : time step between itau s  
   
     !- OUTPUT  
     !-   year : year  
     !-   month : month  
     !-   date : date  
     !-   sec  : seconds since midnight  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER,INTENT(IN) :: itau  
     REAL,INTENT(IN)    :: deltat  
   
     INTEGER,INTENT(OUT) :: year,month,date  
     REAL,INTENT(OUT)    :: sec  
   
     INTEGER :: julian_day  
     REAL    :: julian_sec  
     !---------------------------------------------------------------------  
     julian_day = start_day  
     julian_sec = start_sec+REAL(itau)*deltat  
   
     CALL ju2ymds_internal (julian_day,julian_sec,year,month,date,sec)  
     !-----------------------  
   END SUBROUTINE itau2ymds  
   !-  
257    !===    !===
258    !-  
259    SUBROUTINE isittime &    SUBROUTINE isittime &
260         &  (itau,date0,dt,freq,last_action,last_check,do_action)         &  (itau, date0, dt, freq, last_action, last_check, do_action)
261      !---------------------------------------------------------------------  
262      !- This subroutine checks the time has come for a given action.      ! This subroutine checks the time has come for a given action.
263      !- This is computed from the current time-step(itau).      ! This is computed from the current time-step(itau).
264      !- Thus we need to have the time delta (dt), the frequency      ! Thus we need to have the time delta (dt), the frequency
265      !- of the action (freq) and the last time it was done      ! of the action (freq) and the last time it was done
266      !- (last_action in units of itau).      ! (last_action in units of itau).
267      !- In order to extrapolate when will be the next check we need      ! In order to extrapolate when will be the next check we need
268      !- the time step of the last call (last_check).      ! the time step of the last call (last_check).
269    
270      !- The test is done on the following condition :      ! The test is done on the following condition:
271      !- the distance from the current time to the time for the next      ! the distance from the current time to the time for the next
272      !- action is smaller than the one from the next expected      ! action is smaller than the one from the next expected
273      !- check to the next action.      ! check to the next action.
274      !- When the test is done on the time steps simplifactions make      ! When the test is done on the time steps simplifactions make
275      !- it more difficult to read in the code.      ! it more difficult to read in the code.
276      !- For the real time case it is easier to understand !      ! For the real time case it is easier to understand !
277      !---------------------------------------------------------------------  
278      IMPLICIT NONE      INTEGER, INTENT(IN):: itau
279        REAL, INTENT(IN):: dt, freq
280      INTEGER,INTENT(IN) :: itau      INTEGER, INTENT(IN):: last_action, last_check
281      REAL,INTENT(IN)    :: dt,freq      REAL, INTENT(IN):: date0
282      INTEGER,INTENT(IN) :: last_action,last_check  
283      REAL,INTENT(IN)    :: date0      LOGICAL, INTENT(OUT):: do_action
284    
285      LOGICAL,INTENT(OUT)  :: do_action      REAL:: dt_action, dt_check
286        REAL:: date_last_act, date_next_check, date_next_act, &
287      REAL :: dt_action,dt_check           &        date_now, date_mp1, date_mpf
288      REAL :: date_last_act,date_next_check,date_next_act, &      INTEGER:: year, month, monthp1, day, next_check_itau, next_act_itau
289           &        date_now,date_mp1,date_mpf      INTEGER:: yearp, dayp
290      INTEGER :: year,month,monthp1,day,next_check_itau,next_act_itau      REAL:: sec, secp
291      INTEGER :: yearp,dayp      LOGICAL:: check = .FALSE.
292      REAL :: sec,secp      !--------------------------------------------------------------------
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
293      IF (check) THEN      IF (check) THEN
294         WRITE(*,*) &         WRITE(*, *) &
295              &    "isittime 1.0 ",itau,date0,dt,freq,last_action,last_check              &    "isittime 1.0 ", itau, date0, dt, freq, last_action, last_check
296      ENDIF      ENDIF
297    
298      IF (last_check >= 0) THEN      IF (last_check >= 0) THEN
# Line 452  CONTAINS Line 300  CONTAINS
300         dt_check = (itau-last_check)*dt         dt_check = (itau-last_check)*dt
301         next_check_itau = itau+(itau-last_check)         next_check_itau = itau+(itau-last_check)
302        
303         !-- We are dealing with frequencies in seconds and thus operation         !- We are dealing with frequencies in seconds and thus operation
304         !-- can be done on the time steps.         !- can be done on the time steps.
305        
306         IF (freq > 0) THEN         IF (freq > 0) THEN
307            IF (ABS(dt_action-freq) <= ABS(dt_action+dt_check-freq)) THEN            IF (ABS(dt_action-freq) <= ABS(dt_action+dt_check-freq)) THEN
# Line 462  CONTAINS Line 310  CONTAINS
310               do_action = .FALSE.               do_action = .FALSE.
311            ENDIF            ENDIF
312                
313            !---- Here we deal with frequencies in month and work on julian days.            !--- Here we deal with frequencies in month and work on julian days.
314                
315         ELSE         ELSE
316            date_now = itau2date (itau,date0,dt)            date_now = itau2date (itau, date0, dt)
317            date_last_act = itau2date (last_action,date0,dt)            date_last_act = itau2date (last_action, date0, dt)
318            CALL ju2ymds (date_last_act,year,month,day,sec)            CALL ju2ymds (date_last_act, year, month, day, sec)
319            monthp1 = month-freq            monthp1 = month - freq
320            yearp = year            yearp = year
321                
322            !---- Here we compute what logically should be the next month            !--- Here we compute what logically should be the next month
323                
324            IF (month >= 13) THEN            IF (month >= 13) THEN
325               yearp = year+1               yearp = year+1
326               monthp1 = monthp1-12               monthp1 = monthp1-12
327            ENDIF            ENDIF
328            CALL ymds2ju (year,monthp1,day,sec,date_mpf)            CALL ymds2ju (year, monthp1, day, sec, date_mpf)
329                
330            !---- But it could be that because of a shorter month or a bad            !--- But it could be that because of a shorter month or a bad
331            !---- starting date that we end up further than we should be.            !--- starting date that we end up further than we should be.
332            !---- Thus we compute the first day of the next month.            !--- Thus we compute the first day of the next month.
333            !---- We can not be beyond this date and if we are close            !--- We can not be beyond this date and if we are close
334            !---- then we will take it as it is better.            !--- then we will take it as it is better.
335                
336            monthp1 = month+ABS(freq)            monthp1 = month+ABS(freq)
337            yearp=year            yearp=year
# Line 493  CONTAINS Line 341  CONTAINS
341            ENDIF            ENDIF
342            dayp = 1            dayp = 1
343            secp = 0.0            secp = 0.0
344            CALL ymds2ju (yearp,monthp1,dayp,secp,date_mp1)            CALL ymds2ju (yearp, monthp1, dayp, secp, date_mp1)
345                
346            !---- If date_mp1 is smaller than date_mpf or only less than 4 days            !--- If date_mp1 is smaller than date_mpf or only less than 4 days
347            !---- larger then we take it. This needed to ensure that short month            !--- larger then we take it. This needed to ensure that short month
348            !---- like February do not mess up the thing !            !--- like February do not mess up the thing !
349                
350            IF (date_mp1-date_mpf < 4.) THEN            IF (date_mp1-date_mpf < 4.) THEN
351               date_next_act = date_mp1               date_next_act = date_mp1
352            ELSE            ELSE
353               date_next_act = date_mpf               date_next_act = date_mpf
354            ENDIF            ENDIF
355            date_next_check = itau2date (next_check_itau,date0,dt)            date_next_check = itau2date (next_check_itau, date0, dt)
356                
357            !---- Transform the dates into time-steps for the needed precisions.            !--- Transform the dates into time-steps for the needed precisions.
358                
359            next_act_itau = &            next_act_itau = &
360                 &      last_action+INT((date_next_act-date_last_act)*(un_jour/dt))                 &      last_action+INT((date_next_act-date_last_act)*(un_jour/dt))
361            !-----  
362            IF (   ABS(itau-next_act_itau) &            IF (   ABS(itau-next_act_itau) &
363                 &        <= ABS( next_check_itau-next_act_itau)) THEN                 &        <= ABS( next_check_itau-next_act_itau)) THEN
364               do_action = .TRUE.               do_action = .TRUE.
365               IF (check) THEN               IF (check) THEN
366                  WRITE(*,*) &                  WRITE(*, *) &
367                       &         'ACT-TIME : itau, next_act_itau, next_check_itau : ', &                       &         'ACT-TIME: itau, next_act_itau, next_check_itau: ', &
368                       &         itau,next_act_itau,next_check_itau                       &         itau, next_act_itau, next_check_itau
369                  CALL ju2ymds (date_now,year,month,day,sec)                  CALL ju2ymds (date_now, year, month, day, sec)
370                  WRITE(*,*) 'ACT-TIME : y, m, d, s : ',year,month,day,sec                  WRITE(*, *) 'ACT-TIME: y, m, d, s: ', year, month, day, sec
371                  WRITE(*,*) &                  WRITE(*, *) &
372                       &         'ACT-TIME : date_mp1, date_mpf : ',date_mp1,date_mpf                       &         'ACT-TIME: date_mp1, date_mpf: ', date_mp1, date_mpf
373               ENDIF               ENDIF
374            ELSE            ELSE
375               do_action = .FALSE.               do_action = .FALSE.
# Line 529  CONTAINS Line 377  CONTAINS
377         ENDIF         ENDIF
378        
379         IF (check) THEN         IF (check) THEN
380            WRITE(*,*) "isittime 2.0 ", &            WRITE(*, *) "isittime 2.0 ", &
381                 &     date_next_check,date_next_act,ABS(dt_action-freq), &                 &     date_next_check, date_next_act, ABS(dt_action-freq), &
382                 &     ABS(dt_action+dt_check-freq),dt_action,dt_check, &                 &     ABS(dt_action+dt_check-freq), dt_action, dt_check, &
383                 &     next_check_itau,do_action                 &     next_check_itau, do_action
384         ENDIF         ENDIF
385      ELSE      ELSE
386         do_action=.FALSE.         do_action=.FALSE.
387      ENDIF      ENDIF
388      !----------------------  
389    END SUBROUTINE isittime    END SUBROUTINE isittime
390    !-  
391    !===    !===
392    !-  
393    SUBROUTINE ioconf_calendar (str)    SUBROUTINE ioconf_calendar (str)
394      !---------------------------------------------------------------------  
395      !- This routine allows to configure the calendar to be used.      ! This routine allows to configure the calendar to be used.
396      !- This operation is only allowed once and the first call to      ! This operation is only allowed once and the first call to
397      !- ymds2ju or ju2ymsd will lock the current configuration.      ! ymds2ju or ju2ymsd will lock the current configuration.
398      !- the argument to ioconf_calendar can be any of the following :      ! the argument to ioconf_calendar can be any of the following:
399      !-  - gregorian : This is the gregorian calendar (default here)      !  - gregorian: This is the gregorian calendar (default here)
400      !-  - noleap    : A calendar without leap years = 365 days      !  - noleap: A calendar without leap years = 365 days
401      !-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)      !  - xxxd: A calendar of xxx days (has to be a modulo of 12)
402      !-                with 12 month of equal length      !                with 12 month of equal length
403      !---------------------------------------------------------------------  
404      IMPLICIT NONE      CHARACTER(LEN=*), INTENT(IN):: str
405    
406      CHARACTER(LEN=*),INTENT(IN) :: str      INTEGER:: leng, ipos
407        CHARACTER(LEN=10):: str10
408      INTEGER :: leng,ipos      !--------------------------------------------------------------------
     CHARACTER(LEN=10) :: str10  
     !---------------------------------------------------------------------  
409    
410      ! 1.0 Clean up the sring !      ! 1.0 Clean up the sring !
411    
412      CALL strlowercase (str)      CALL strlowercase (str)
413    
414      IF (.NOT.lock_unan) THEN      IF (.NOT.lock_unan) THEN
415         !---  
416         lock_unan=.TRUE.         lock_unan=.TRUE.
417         !---  
418         SELECT CASE(str)         SELECT CASE(str)
419         CASE('gregorian')         CASE('gregorian')
420            calendar_used = 'gregorian'            calendar_used = 'gregorian'
421            un_an = 365.2425            un_an = 365.2425
422            mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
423         CASE('standard')         CASE('standard')
424            calendar_used = 'gregorian'            calendar_used = 'gregorian'
425            un_an = 365.2425            un_an = 365.2425
426            mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
427         CASE('proleptic_gregorian')         CASE('proleptic_gregorian')
428            calendar_used = 'gregorian'            calendar_used = 'gregorian'
429            un_an = 365.2425            un_an = 365.2425
430            mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
431         CASE('noleap')         CASE('noleap')
432            calendar_used = 'noleap'            calendar_used = 'noleap'
433            un_an = 365.0            un_an = 365.0
434            mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
435         CASE('365_day')         CASE('365_day')
436            calendar_used = 'noleap'            calendar_used = 'noleap'
437            un_an = 365.0            un_an = 365.0
438            mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
439         CASE('365d')         CASE('365d')
440            calendar_used = 'noleap'            calendar_used = 'noleap'
441            un_an = 365.0            un_an = 365.0
442            mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
443         CASE('all_leap')         CASE('all_leap')
444            calendar_used = 'all_leap'            calendar_used = 'all_leap'
445            un_an = 366.0            un_an = 366.0
446            mon_len(:)=(/31,29,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
447         CASE('366_day')         CASE('366_day')
448            calendar_used = 'all_leap'            calendar_used = 'all_leap'
449            un_an = 366.0            un_an = 366.0
450            mon_len(:)=(/31,29,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
451         CASE('366d')         CASE('366d')
452            calendar_used = 'all_leap'            calendar_used = 'all_leap'
453            un_an = 366.0            un_an = 366.0
454            mon_len(:)=(/31,29,31,30,31,30,31,31,30,31,30,31/)            mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
455         CASE DEFAULT         CASE DEFAULT
456            ipos = INDEX(str,'d')            ipos = INDEX(str, 'd')
457            IF (ipos == 4) THEN            IF (ipos == 4) THEN
458               READ(str(1:3),'(I3)') leng               READ(str(1:3), '(I3)') leng
459               IF ( (MOD(leng,12) == 0).AND.(leng > 1) ) THEN               IF ( (MOD(leng, 12) == 0).AND.(leng > 1) ) THEN
460                  calendar_used = str                  calendar_used = str
461                  un_an = leng                  un_an = leng
462                  mon_len(:) = leng                  mon_len(:) = leng
463               ELSE               ELSE
464                  CALL histerr (3,'ioconf_calendar', &                  CALL histerr (3, 'ioconf_calendar', &
465                       &         'The length of the year as to be a modulo of 12', &                       &         'The length of the year as to be a modulo of 12', &
466                       &         'so that it can be divided into 12 month of equal length', &                       &         'so that it can be divided into 12 month of equal length', &
467                       &         str)                       &         str)
468               ENDIF               ENDIF
469            ELSE            ELSE
470               CALL histerr (3,'ioconf_calendar', &               CALL histerr (3, 'ioconf_calendar', &
471                    &       'Unrecognized input, please ceck the man pages.',str,' ')                    &       'Unrecognized input, please ceck the man pages.', str, ' ')
472            ENDIF            ENDIF
473         END SELECT         END SELECT
474      ELSE      ELSE
475         WRITE(str10,'(f10.4)') un_an         WRITE(str10, '(f10.4)') un_an
476         CALL histerr (2,'ioconf_calendar', &         CALL histerr (2, 'ioconf_calendar', &
477              &   'The calendar was already used or configured. You are not', &              &   'The calendar was already used or configured. You are not', &
478              &   'allowed to change it again. '// &              &   'allowed to change it again. '// &
479              &   'The following length of year is used :',str10)              &   'The following length of year is used:', str10)
480      ENDIF      ENDIF
     !-----------------------------  
   END SUBROUTINE ioconf_calendar  
   !-  
   !===  
   !-  
   SUBROUTINE ioconf_startdate_simple (julian)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     REAL,INTENT(IN) :: julian  
   
     INTEGER :: julian_day  
     REAL    :: julian_sec  
     !---------------------------------------------------------------------  
     julian_day = INT(julian)  
     julian_sec = (julian-julian_day)*un_jour  
481    
482      CALL ioconf_startdate_internal (julian_day,julian_sec)    END SUBROUTINE ioconf_calendar
     !-------------------------------------  
   END SUBROUTINE ioconf_startdate_simple  
   !-  
   !===  
   !-  
   SUBROUTINE ioconf_startdate_ymds (year,month,day,sec)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER,INTENT(IN) :: year,month,day  
     REAL,INTENT(IN)    :: sec  
   
     INTEGER :: julian_day  
     REAL    :: julian_sec  
     !---------------------------------------------------------------------  
     CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)  
   
     CALL ioconf_startdate_internal (julian_day,julian_sec)  
     !-----------------------------------  
   END SUBROUTINE ioconf_startdate_ymds  
   !-  
   !===  
   !-  
   SUBROUTINE ioconf_startdate_internal (julian_day,julian_sec)  
     !---------------------------------------------------------------------  
     ! This subroutine allows to set the startdate for later  
     ! use. It allows the applications to access the date directly from  
     ! the timestep. In order to avoid any problems the start date will  
     ! be locked and can not be changed once set.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER,INTENT(IN)  :: julian_day  
     REAL,INTENT(IN)     :: julian_sec  
   
     CHARACTER(len=70) :: str70a,str70b  
     !---------------------------------------------------------------------  
     IF (.NOT.lock_startdate) THEN  
        lock_startdate = .TRUE.  
        start_day = julian_day  
        start_sec = julian_sec  
     ELSE  
        WRITE(str70a,'("The date you tried to set : ",f10.4)') &  
             &   julian_day,julian_sec/un_jour  
        WRITE(str70b, &  
             &   '("The date which was already set in the calendar : ",f10.4)') &  
             &   start_day+start_sec/un_jour  
        CALL histerr (2,'ioconf_startdate', &  
             &   'The start date has already been set and you tried to change it', &  
             &   str70a,str70b)  
     ENDIF  
   
     lock_startdate = .TRUE.  
     !---------------------------------------  
   END SUBROUTINE ioconf_startdate_internal  
   !-  
   !===  
   !-  
   SUBROUTINE ioget_calendar_str (str)  
     !---------------------------------------------------------------------  
     !- This subroutine returns the name of the calendar used here.  
     !- Three options exist :  
     !-  - gregorian : This is the gregorian calendar (default here)  
     !-  - noleap    : A calendar without leap years = 365 days  
     !-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)  
     !-                with 12 month of equal length  
   
     !- This routine will lock the calendar.  
     !- You do not want it to change after your inquiry.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     CHARACTER(LEN=*),INTENT(OUT) :: str  
     !---------------------------------------------------------------------  
     lock_unan = .TRUE.  
   
     str = calendar_used  
     !--------------------------------  
   END SUBROUTINE ioget_calendar_str  
   !-  
   !===  
   !-  
   SUBROUTINE ioget_calendar_real1 (long_an)  
     !---------------------------------------------------------------------  
     !- This subroutine returns the name of the calendar used here.  
     !- Three options exist :  
     !-  - gregorian : This is the gregorian calendar (default here)  
     !-  - noleap    : A calendar without leap years = 365 days  
     !-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)  
     !-                with 12 month of equal length  
   
     !- This routine will lock the calendar.  
     !- You do not want it to change after your inquiry.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     REAL,INTENT(OUT) :: long_an  
     !---------------------------------------------------------------------  
     lock_unan = .TRUE.  
   
     long_an = un_an  
     !----------------------------------  
   END SUBROUTINE ioget_calendar_real1  
   !-  
   !===  
   !-  
   SUBROUTINE ioget_calendar_real2 (long_an,long_jour)  
     !---------------------------------------------------------------------  
     !- This subroutine returns the name of the calendar used here.  
     !- Three options exist :  
     !-  - gregorian : This is the gregorian calendar (default here)  
     !-  - noleap    : A calendar without leap years = 365 days  
     !-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)  
     !-                with 12 month of equal length  
   
     !- This routine will lock the calendar.  
     !- You do not want it to change after your inquiry.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     REAL,INTENT(OUT) :: long_an,long_jour  
     !---------------------------------------------------------------------  
     lock_unan = .TRUE.  
   
     long_an = un_an  
     long_jour = un_jour  
     !----------------------------------  
   END SUBROUTINE ioget_calendar_real2  
   !-  
   !===  
   !-  
   SUBROUTINE ioget_timestamp (string)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     CHARACTER(LEN=30),INTENT(OUT) :: string  
   
     INTEGER :: date_time(8)  
     CHARACTER(LEN=10) :: bigben(3)  
     !---------------------------------------------------------------------  
     IF (INDEX(time_stamp,'XXXXXX') > 0) THEN  
        CALL DATE_AND_TIME (bigben(1),bigben(2),bigben(3),date_time)  
        !---  
        WRITE(time_stamp, &  
             &   "(I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2,' GMT',a5)") &  
             &   date_time(1),cal(date_time(2)),date_time(3),date_time(5), &  
             &   date_time(6),date_time(7),bigben(3)  
     ENDIF  
483    
     string = time_stamp  
     !-----------------------------  
   END SUBROUTINE ioget_timestamp  
   !-  
   !===  
   !-  
   SUBROUTINE time_add &  
        &  (year_s,month_s,day_s,sec_s,sec_increment, &  
        &   year_e,month_e,day_e,sec_e)  
     !---------------------------------------------------------------------  
     !- This subroutine allows to increment a date by a number of seconds.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER,INTENT(IN) :: year_s,month_s,day_s  
     REAL,INTENT(IN)    :: sec_s  
     !!  
     ! Time in seconds to be added to the date  
     !!  
     REAL,INTENT(IN)    :: sec_increment  
   
     INTEGER,INTENT(OUT) :: year_e,month_e,day_e  
     REAL,INTENT(OUT)    :: sec_e  
   
     INTEGER :: julian_day  
     REAL    :: julian_sec  
     !---------------------------------------------------------------------  
     CALL ymds2ju_internal &  
          &  (year_s,month_s,day_s,sec_s,julian_day,julian_sec)  
   
     julian_sec = julian_sec+sec_increment  
   
     CALL ju2ymds_internal &  
          &  (julian_day,julian_sec,year_e,month_e,day_e,sec_e)  
     !----------------------  
   END SUBROUTINE time_add  
   !-  
   !===  
   !-  
   SUBROUTINE time_diff &  
        &  (year_s,month_s,day_s,sec_s,year_e,month_e,day_e,sec_e,sec_diff)  
     !---------------------------------------------------------------------  
     !- This subroutine allows to determine the number of seconds  
     !- between two dates.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER,INTENT(IN) :: year_s,month_s,day_s  
     REAL,INTENT(IN)    :: sec_s  
     INTEGER,INTENT(IN) :: year_e,month_e,day_e  
     REAL,INTENT(IN)    :: sec_e  
     !!  
     ! Time in seconds between the two dates  
     !!  
     REAL,INTENT(OUT)    :: sec_diff  
   
     INTEGER :: julian_day_s,julian_day_e,day_diff  
     REAL    :: julian_sec_s,julian_sec_e  
     !---------------------------------------------------------------------  
     CALL ymds2ju_internal &  
          &  (year_s,month_s,day_s,sec_s,julian_day_s,julian_sec_s)  
     CALL ymds2ju_internal &  
          &  (year_e,month_e,day_e,sec_e,julian_day_e,julian_sec_e)  
   
     day_diff = julian_day_e-julian_day_s  
     sec_diff = julian_sec_e-julian_sec_s  
   
     sec_diff = sec_diff+day_diff*un_jour  
     !-----------------------  
   END SUBROUTINE time_diff  
   !-  
   !===  
   !-  
484  END MODULE calendar  END MODULE calendar
Legend:
Removed from v.30  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21