IOIPSL/Calendar/isittime.f

module isittime_m

  implicit none

contains

  SUBROUTINE isittime(itau, date0, dt, freq, last_action, last_check, do_action)

    ! This subroutine checks the time has come for a given action.
    ! This is computed from the current time-step(itau).
    ! Thus we need to have the time delta (dt), the frequency
    ! of the action (freq) and the last time it was done
    ! (last_action in units of itau).
    ! In order to extrapolate when will be the next check we need
    ! the time step of the last call (last_check).

    ! The test is done on the following condition:
    ! the distance from the current time to the time for the next
    ! action is smaller than the one from the next expected
    ! check to the next action.
    ! When the test is done on the time steps simplifactions make
    ! it more difficult to read in the code.
    ! For the real time case it is easier to understand !

    use calendar
    use itau2date_m
    use ju2ymds_m
    use ymds2ju_m

    INTEGER, INTENT(IN):: itau
    REAL, INTENT(IN):: date0
    REAL, INTENT(IN):: dt, freq
    INTEGER, INTENT(IN):: last_action, last_check
    LOGICAL, INTENT(OUT):: do_action

    REAL:: dt_action, dt_check
    REAL:: date_last_act, date_next_check, date_next_act, &
         &        date_now, date_mp1, date_mpf
    INTEGER:: year, month, monthp1, day, next_check_itau, next_act_itau
    INTEGER:: yearp, dayp
    REAL:: sec, secp
    LOGICAL:: check = .FALSE.
    !--------------------------------------------------------------------
    IF (check) THEN
       WRITE(*, *) &
            &    "isittime 1.0 ", itau, date0, dt, freq, last_action, last_check
    ENDIF

    IF (last_check >= 0) THEN
       dt_action = (itau-last_action)*dt
       dt_check = (itau-last_check)*dt
       next_check_itau = itau+(itau-last_check)

       !- We are dealing with frequencies in seconds and thus operation
       !- can be done on the time steps.

       IF (freq > 0) THEN
          IF (ABS(dt_action-freq) <= ABS(dt_action+dt_check-freq)) THEN
             do_action = .TRUE.
          ELSE
             do_action = .FALSE.
          ENDIF

          !--- Here we deal with frequencies in month and work on julian days.

       ELSE
          date_now = itau2date (itau, date0, dt)
          date_last_act = itau2date (last_action, date0, dt)
          CALL ju2ymds (date_last_act, year, month, day, sec)
          monthp1 = month - freq
          yearp = year

          !--- Here we compute what logically should be the next month

          IF (month >= 13) THEN
             yearp = year+1
             monthp1 = monthp1-12
          ENDIF
          CALL ymds2ju (year, monthp1, day, sec, date_mpf)

          !--- But it could be that because of a shorter month or a bad
          !--- starting date that we end up further than we should be.
          !--- Thus we compute the first day of the next month.
          !--- We can not be beyond this date and if we are close
          !--- then we will take it as it is better.

          monthp1 = month+ABS(freq)
          yearp=year
          IF (monthp1 >= 13) THEN
             yearp = year+1
             monthp1 = monthp1 -12
          ENDIF
          dayp = 1
          secp = 0.0
          CALL ymds2ju (yearp, monthp1, dayp, secp, date_mp1)

          !--- If date_mp1 is smaller than date_mpf or only less than 4 days
          !--- larger then we take it. This needed to ensure that short month
          !--- like February do not mess up the thing !

          IF (date_mp1-date_mpf < 4.) THEN
             date_next_act = date_mp1
          ELSE
             date_next_act = date_mpf
          ENDIF
          date_next_check = itau2date (next_check_itau, date0, dt)

          !--- Transform the dates into time-steps for the needed precisions.

          next_act_itau = &
               &      last_action+INT((date_next_act-date_last_act)*(un_jour/dt))

          IF (   ABS(itau-next_act_itau) &
               &        <= ABS( next_check_itau-next_act_itau)) THEN
             do_action = .TRUE.
             IF (check) THEN
                WRITE(*, *) &
                     &         'ACT-TIME: itau, next_act_itau, next_check_itau: ', &
                     &         itau, next_act_itau, next_check_itau
                CALL ju2ymds (date_now, year, month, day, sec)
                WRITE(*, *) 'ACT-TIME: y, m, d, s: ', year, month, day, sec
                WRITE(*, *) &
                     &         'ACT-TIME: date_mp1, date_mpf: ', date_mp1, date_mpf
             ENDIF
          ELSE
             do_action = .FALSE.
          ENDIF
       ENDIF

       IF (check) THEN
          WRITE(*, *) "isittime 2.0 ", &
               &     date_next_check, date_next_act, ABS(dt_action-freq), &
               &     ABS(dt_action+dt_check-freq), dt_action, dt_check, &
               &     next_check_itau, do_action
       ENDIF
    ELSE
       do_action=.FALSE.
    ENDIF

  END SUBROUTINE isittime

end module isittime_m
1	guez	92	module isittime_m
2
3			implicit none
4
5			contains
6
7	guez	178	SUBROUTINE isittime(itau, date0, dt, freq, last_action, last_check, do_action)
8	guez	92
9			! This subroutine checks the time has come for a given action.
10			! This is computed from the current time-step(itau).
11			! Thus we need to have the time delta (dt), the frequency
12			! of the action (freq) and the last time it was done
13			! (last_action in units of itau).
14			! In order to extrapolate when will be the next check we need
15			! the time step of the last call (last_check).
16
17			! The test is done on the following condition:
18			! the distance from the current time to the time for the next
19			! action is smaller than the one from the next expected
20			! check to the next action.
21			! When the test is done on the time steps simplifactions make
22			! it more difficult to read in the code.
23			! For the real time case it is easier to understand !
24
25			use calendar
26			use itau2date_m
27			use ju2ymds_m
28			use ymds2ju_m
29
30			INTEGER, INTENT(IN):: itau
31	guez	178	REAL, INTENT(IN):: date0
32	guez	92	REAL, INTENT(IN):: dt, freq
33			INTEGER, INTENT(IN):: last_action, last_check
34			LOGICAL, INTENT(OUT):: do_action
35
36			REAL:: dt_action, dt_check
37			REAL:: date_last_act, date_next_check, date_next_act, &
38			& date_now, date_mp1, date_mpf
39			INTEGER:: year, month, monthp1, day, next_check_itau, next_act_itau
40			INTEGER:: yearp, dayp
41			REAL:: sec, secp
42			LOGICAL:: check = .FALSE.
43			!--------------------------------------------------------------------
44			IF (check) THEN
45			WRITE(, ) &
46			& "isittime 1.0 ", itau, date0, dt, freq, last_action, last_check
47			ENDIF
48
49			IF (last_check >= 0) THEN
50			dt_action = (itau-last_action)*dt
51			dt_check = (itau-last_check)*dt
52			next_check_itau = itau+(itau-last_check)
53
54			!- We are dealing with frequencies in seconds and thus operation
55			!- can be done on the time steps.
56
57			IF (freq > 0) THEN
58			IF (ABS(dt_action-freq) <= ABS(dt_action+dt_check-freq)) THEN
59			do_action = .TRUE.
60			ELSE
61			do_action = .FALSE.
62			ENDIF
63
64			!--- Here we deal with frequencies in month and work on julian days.
65
66			ELSE
67			date_now = itau2date (itau, date0, dt)
68			date_last_act = itau2date (last_action, date0, dt)
69			CALL ju2ymds (date_last_act, year, month, day, sec)
70			monthp1 = month - freq
71			yearp = year
72
73			!--- Here we compute what logically should be the next month
74
75			IF (month >= 13) THEN
76			yearp = year+1
77			monthp1 = monthp1-12
78			ENDIF
79			CALL ymds2ju (year, monthp1, day, sec, date_mpf)
80
81			!--- But it could be that because of a shorter month or a bad
82			!--- starting date that we end up further than we should be.
83			!--- Thus we compute the first day of the next month.
84			!--- We can not be beyond this date and if we are close
85			!--- then we will take it as it is better.
86
87			monthp1 = month+ABS(freq)
88			yearp=year
89			IF (monthp1 >= 13) THEN
90			yearp = year+1
91			monthp1 = monthp1 -12
92			ENDIF
93			dayp = 1
94			secp = 0.0
95			CALL ymds2ju (yearp, monthp1, dayp, secp, date_mp1)
96
97			!--- If date_mp1 is smaller than date_mpf or only less than 4 days
98			!--- larger then we take it. This needed to ensure that short month
99			!--- like February do not mess up the thing !
100
101			IF (date_mp1-date_mpf < 4.) THEN
102			date_next_act = date_mp1
103			ELSE
104			date_next_act = date_mpf
105			ENDIF
106			date_next_check = itau2date (next_check_itau, date0, dt)
107
108			!--- Transform the dates into time-steps for the needed precisions.
109
110			next_act_itau = &
111			& last_action+INT((date_next_act-date_last_act)*(un_jour/dt))
112
113			IF ( ABS(itau-next_act_itau) &
114			& <= ABS( next_check_itau-next_act_itau)) THEN
115			do_action = .TRUE.
116			IF (check) THEN
117			WRITE(, ) &
118			& 'ACT-TIME: itau, next_act_itau, next_check_itau: ', &
119			& itau, next_act_itau, next_check_itau
120			CALL ju2ymds (date_now, year, month, day, sec)
121			WRITE(, ) 'ACT-TIME: y, m, d, s: ', year, month, day, sec
122			WRITE(, ) &
123			& 'ACT-TIME: date_mp1, date_mpf: ', date_mp1, date_mpf
124			ENDIF
125			ELSE
126			do_action = .FALSE.
127			ENDIF
128			ENDIF
129
130			IF (check) THEN
131			WRITE(, ) "isittime 2.0 ", &
132			& date_next_check, date_next_act, ABS(dt_action-freq), &
133			& ABS(dt_action+dt_check-freq), dt_action, dt_check, &
134			& next_check_itau, do_action
135			ENDIF
136			ELSE
137			do_action=.FALSE.
138			ENDIF
139
140			END SUBROUTINE isittime
141
142			end module isittime_m