SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
temporal_dists.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE temporal_dists(KYEARF, KMONTHF, KDAYF, PSECF, &
7  kyeari, kmonthi, kdayi, pseci, &
8  pdist )
9 ! #############################################################
10 !
11 !!**** *TEMPORAL_DISTS* - finds the number of secunds between 2 dates
12 !!
13 !! PURPOSE
14 !! -------
15 !!
16 !! WARNING
17 !!
18 !! -----> Only correct for dates between 19900301 and 21000228 <-----
19 !!
20 !! The correct test should be:
21 !! IF( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0))THEN
22 !!
23 !!** METHOD
24 !! ------
25 !!
26 !! A comparison term by term of the elements of the 2 dates is performed.
27 !! and the temporal distance between the 2 dates is then deduced.
28 !!
29 !! EXTERNAL
30 !! --------
31 !!
32 !! IMPLICIT ARGUMENTS
33 !! ------------------
34 !!
35 !! REFERENCE
36 !! ---------
37 !!
38 !! Book 2
39 !!
40 !! AUTHOR
41 !! ------
42 !!
43 ! J.Stein Meteo-France
44 !!
45 !! MODIFICATIONS
46 !! -------------
47 !! Original 02/01/96
48 !! PP. 06/08: Add case where differents years and same month
49 !! for more-than-1year simulations
50 !-------------------------------------------------------------------------------
51 !
52 !* 0. DECLARATIONS
53 ! ------------
54 !
55 USE modd_surf_par
56 !
57 !
58 USE yomhook ,ONLY : lhook, dr_hook
59 USE parkind1 ,ONLY : jprb
60 !
61 IMPLICIT NONE
62 !
63 !* 0.1 Declaration of arguments
64 ! ------------------------
65 INTEGER, INTENT(IN) :: kyearf ! year of Final date
66 INTEGER, INTENT(IN) :: kmonthf ! month of Final date
67 INTEGER, INTENT(IN) :: kdayf ! day of Final date
68 REAL, INTENT(IN) :: psecf ! number of seconds since date at 00 UTC
69  ! of Final date
70 INTEGER, INTENT(IN) :: kyeari ! year of Initial date
71 INTEGER, INTENT(IN) :: kmonthi ! month of Initial date
72 INTEGER, INTENT(IN) :: kdayi ! day of Initial date
73 REAL, INTENT(IN) :: pseci ! number of seconds since date at 00 UTC
74  ! of Initial date
75 REAL, INTENT(OUT):: pdist ! temporal distance in secunds between the final
76  ! and initial date
77 !
78 !* 0.2 Declaration of local variables
79 ! ------------------------------
80 !
81 INTEGER :: idays ! number of days between the two dates
82 INTEGER :: jmonth,jyear ! loop index on months or years
83 REAL(KIND=JPRB) :: zhook_handle
84 !
85 !-------------------------------------------------------------------------------
86 !
87 !* 1. SAME YEARS AND SAME MONTHS
88 ! --------------------------
89 !
90 IF (lhook) CALL dr_hook('TEMPORAL_DISTS',0,zhook_handle)
91 IF ( (kyearf==kyeari) .AND. (kmonthf==kmonthi) ) THEN
92  pdist = ( kdayf-kdayi) * 86400. + psecf - pseci
93  ! check chronological order
94  IF (pdist < 0.) pdist=xundef
95 END IF
96 !
97 !-------------------------------------------------------------------------------
98 !
99 !* 2. SAME YEARS AND DIFFERENT MONTHS
100 ! -------------------------------
101 !
102 IF ( (kyearf==kyeari) .AND. (kmonthf/=kmonthi) ) THEN
103  ! check chronological order
104  IF ( kmonthf < kmonthi ) THEN
105  pdist=xundef
106  IF (lhook) CALL dr_hook('TEMPORAL_DISTS',1,zhook_handle)
107  RETURN
108  END IF
109  !
110  ! cumulate the number of days for the months in between KMONTHF-1 and
111  ! KMONTHI
112  idays = 0
113  DO jmonth = kmonthi, kmonthf-1
114  SELECT CASE (jmonth)
115  CASE(4,6,9,11)
116  idays=idays+30
117  CASE(1,3,5,7:8,10,12)
118  idays=idays+31
119  CASE(2)
120  IF (mod(kyeari,4)==0) THEN
121  idays=idays+29
122  ELSE
123  idays=idays+28
124  ENDIF
125  END SELECT
126  END DO
127  !
128  ! compute the temporal distance
129  pdist = ( idays + kdayf - kdayi) * 86400. + psecf - pseci
130  !
131 END IF
132 !
133 !-------------------------------------------------------------------------------
134 !
135 !* 3. DIFFERENT YEARS AND DIFFERENT MONTHS
136 ! ------------------------------------
137 !
138 IF ( (kyearf/=kyeari) .AND. (kmonthf/=kmonthi) ) THEN
139  ! check chronological order
140  IF ( kyearf < kyeari ) THEN
141  pdist=xundef
142  IF (lhook) CALL dr_hook('TEMPORAL_DISTS',1,zhook_handle)
143  RETURN
144  END IF
145  !
146  ! cumulate the number of days for the months in between KMONTHI and
147  ! December
148  idays = 0
149  DO jmonth = kmonthi, 12
150  SELECT CASE (jmonth)
151  CASE(4,6,9,11)
152  idays=idays+30
153  CASE(1,3,5,7:8,10,12)
154  idays=idays+31
155  CASE(2)
156  IF (mod(kyeari,4)==0) THEN
157  idays=idays+29
158  ELSE
159  idays=idays+28
160  ENDIF
161  END SELECT
162  END DO
163  DO jmonth = 1,kmonthf-1
164  SELECT CASE (jmonth)
165  CASE(4,6,9,11)
166  idays=idays+30
167  CASE(1,3,5,7:8,10,12)
168  idays=idays+31
169  CASE(2)
170  IF (mod(kyearf,4)==0) THEN
171  idays=idays+29
172  ELSE
173  idays=idays+28
174  ENDIF
175  END SELECT
176  END DO
177  ! add the number of days corresponding to full years between the two dates
178  DO jyear=kyeari+1, kyearf-1
179  IF (mod(jyear,4)==0) THEN
180  idays=idays+366
181  ELSE
182  idays=idays+365
183  END IF
184  END DO
185  !
186  ! compute the temporal distance
187  pdist = ( idays + kdayf - kdayi) * 86400. + psecf - pseci
188  !
189 END IF
190 !
191 !
192 !! 4. SUPPLEMENTARY CASE FOR DIFFERENT YEARS AND SAME MONTH
193 ! ------------------------------------------------------------
194 IF ( (kyearf/=kyeari) .AND. (kmonthf==kmonthi) ) THEN
195  ! check chronological order
196  IF ( kyearf < kyeari ) THEN
197  pdist=xundef
198  IF (lhook) CALL dr_hook('TEMPORAL_DISTS',1,zhook_handle)
199  RETURN
200  END IF
201  !
202  ! cumulate the number of days for the months in between KMONTHI and
203  ! December => IDAYS = 0 here
204  idays = 0
205  ! add the number of days corresponding to full years between the two dates
206  DO jyear=kyeari+1, kyearf-1
207  IF (mod(jyear,4)==0) THEN
208  idays=idays+366
209  ELSE
210  idays=idays+365
211  END IF
212  END DO
213  !
214  ! compute the temporal distance
215  pdist = ( idays + kdayf - kdayi) * 86400. + psecf - pseci
216  !
217 END IF
218 IF (lhook) CALL dr_hook('TEMPORAL_DISTS',1,zhook_handle)
219 !-------------------------------------------------------------------------------
220 !
221 END SUBROUTINE temporal_dists
subroutine temporal_dists(KYEARF, KMONTHF, KDAYF, PSECF, KYEARI, KMONTHI, KDAYI, PSECI, PDIST)