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	module isittime_m
2
3	implicit none
4
5	contains
6
7	SUBROUTINE isittime(itau, date0, dt, freq, last_action, last_check, do_action)
8
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	REAL, INTENT(IN):: date0
32	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