Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

ESMF_Time.F90 @ 3567

Last change on this file since 3567 was 11, checked in by aslmd, 14 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 35.6 KB

Line
1	!
2	! Earth System Modeling Framework
3	! Copyright 2002-2003, University Corporation for Atmospheric Research,
4	! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
5	! Laboratory, University of Michigan, National Centers for Environmental
6	! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
7	! NASA Goddard Space Flight Center.
8	! Licensed under the GPL.
9	!
10	!==============================================================================
11	!
12	! ESMF Time Module
13	module ESMF_TimeMod
14	!
15	!==============================================================================
16	!
17	! This file contains the Time class definition and all Time class methods.
18	!
19	!------------------------------------------------------------------------------
20	! INCLUDES
21	#include <ESMF_TimeMgr.inc>
22
23	!==============================================================================
24	!BOPI
25	! !MODULE: ESMF_TimeMod
26	!
27	! !DESCRIPTION:
28	! Part of Time Manager F90 API wrapper of C++ implemenation
29	!
30	! Defines F90 wrapper entry points for corresponding
31	! C++ class {\tt ESMC\_Time} implementation
32	!
33	! See {\tt ../include/ESMC\_Time.h} for complete description
34	!
35	!------------------------------------------------------------------------------
36	! !USES:
37	! inherit from ESMF base class
38	use ESMF_BaseMod
39
40	! inherit from base time class
41	use ESMF_BaseTimeMod
42
43	! associated derived types
44	use ESMF_TimeIntervalMod
45	use ESMF_CalendarMod
46	use ESMF_Stubs
47
48	implicit none
49	!
50	!------------------------------------------------------------------------------
51	! !PRIVATE TYPES:
52	private
53	!------------------------------------------------------------------------------
54	! ! ESMF_Time
55	!
56	! ! F90 class type to match C++ Time class in size only;
57	! ! all dereferencing within class is performed by C++ implementation
58
59	type ESMF_Time
60	type(ESMF_BaseTime) :: basetime ! inherit base class
61	! time instant is expressed as year + basetime
62	integer :: YR
63	type(ESMF_Calendar), pointer :: calendar ! associated calendar
64	end type
65
66	!------------------------------------------------------------------------------
67	! !PUBLIC TYPES:
68	public ESMF_Time
69	!------------------------------------------------------------------------------
70	!
71	! !PUBLIC MEMBER FUNCTIONS:
72	public ESMF_TimeGet
73	public ESMF_TimeSet
74
75	! Required inherited and overridden ESMF_Base class methods
76
77	public ESMF_TimeCopy
78
79	! !PRIVATE MEMBER FUNCTIONS:
80
81	private ESMF_TimeGetDayOfYear
82	private ESMF_TimeGetDayOfYearInteger
83
84	! Inherited and overloaded from ESMF_BaseTime
85
86	! NOTE: ESMF_TimeInc, ESMF_TimeDec, ESMF_TimeDiff, ESMF_TimeEQ,
87	! ESMF_TimeNE, ESMF_TimeLT, ESMF_TimeGT, ESMF_TimeLE, and
88	! ESMF_TimeGE are PUBLIC only to work around bugs in the
89	! PGI 5.1-x compilers. They should all be PRIVATE.
90
91	public operator(+)
92	public ESMF_TimeInc
93
94	public operator(-)
95	public ESMF_TimeDec
96	public ESMF_TimeDec2
97	public ESMF_TimeDiff
98
99	public operator(.EQ.)
100	public ESMF_TimeEQ
101
102	public operator(.NE.)
103	public ESMF_TimeNE
104
105	public operator(.LT.)
106	public ESMF_TimeLT
107
108	public operator(.GT.)
109	public ESMF_TimeGT
110
111	public operator(.LE.)
112	public ESMF_TimeLE
113
114	public operator(.GE.)
115	public ESMF_TimeGE
116
117	!EOPI
118
119	!==============================================================================
120	!
121	! INTERFACE BLOCKS
122	!
123	!==============================================================================
124	!BOP
125	! !INTERFACE:
126	interface ESMF_TimeGetDayOfYear
127
128	! !PRIVATE MEMBER FUNCTIONS:
129	module procedure ESMF_TimeGetDayOfYearInteger
130
131	! !DESCRIPTION:
132	! This interface overloads the {\tt ESMF\_GetDayOfYear} method
133	! for the {\tt ESMF\_Time} class
134	!
135	!EOP
136	end interface
137	!
138	!------------------------------------------------------------------------------
139	!BOP
140	! !INTERFACE:
141	interface operator(+)
142
143	! !PRIVATE MEMBER FUNCTIONS:
144	module procedure ESMF_TimeInc, ESMF_TimeInc2
145
146	! !DESCRIPTION:
147	! This interface overloads the + operator for the {\tt ESMF\_Time} class
148	!
149	!EOP
150	end interface
151	!
152	!------------------------------------------------------------------------------
153	!BOP
154	! !INTERFACE:
155	interface assignment (=)
156
157	! !PRIVATE MEMBER FUNCTIONS:
158	module procedure ESMF_TimeCopy
159
160	! !DESCRIPTION:
161	! This interface overloads the = operator for the {\tt ESMF\_Time} class
162	!
163	!EOP
164	end interface
165	!
166	!------------------------------------------------------------------------------
167	!BOP
168	! !INTERFACE:
169	interface operator(-)
170
171	! !PRIVATE MEMBER FUNCTIONS:
172	module procedure ESMF_TimeDec, ESMF_TimeDec2
173
174	! !DESCRIPTION:
175	! This interface overloads the - operator for the {\tt ESMF\_Time} class
176	!
177	!EOP
178	end interface
179	!
180	!------------------------------------------------------------------------------
181	!BOP
182	! !INTERFACE:
183	interface operator(-)
184
185	! !PRIVATE MEMBER FUNCTIONS:
186	module procedure ESMF_TimeDiff
187
188	! !DESCRIPTION:
189	! This interface overloads the - operator for the {\tt ESMF\_Time} class
190	!
191	!EOP
192	end interface
193	!
194	!------------------------------------------------------------------------------
195	!BOP
196	! !INTERFACE:
197	interface operator(.EQ.)
198
199	! !PRIVATE MEMBER FUNCTIONS:
200	module procedure ESMF_TimeEQ
201
202	! !DESCRIPTION:
203	! This interface overloads the .EQ. operator for the {\tt ESMF\_Time} class
204	!
205	!EOP
206	end interface
207	!
208	!------------------------------------------------------------------------------
209	!BOP
210	! !INTERFACE:
211	interface operator(.NE.)
212
213	! !PRIVATE MEMBER FUNCTIONS:
214	module procedure ESMF_TimeNE
215
216	! !DESCRIPTION:
217	! This interface overloads the .NE. operator for the {\tt ESMF\_Time} class
218	!
219	!EOP
220	end interface
221	!
222	!------------------------------------------------------------------------------
223	!BOP
224	! !INTERFACE:
225	interface operator(.LT.)
226
227	! !PRIVATE MEMBER FUNCTIONS:
228	module procedure ESMF_TimeLT
229
230	! !DESCRIPTION:
231	! This interface overloads the .LT. operator for the {\tt ESMF\_Time} class
232	!
233	!EOP
234	end interface
235	!
236	!------------------------------------------------------------------------------
237	!BOP
238	! !INTERFACE:
239	interface operator(.GT.)
240
241	! !PRIVATE MEMBER FUNCTIONS:
242	module procedure ESMF_TimeGT
243
244	! !DESCRIPTION:
245	! This interface overloads the .GT. operator for the {\tt ESMF\_Time} class
246	!
247	!EOP
248	end interface
249	!
250	!------------------------------------------------------------------------------
251	!BOP
252	! !INTERFACE:
253	interface operator(.LE.)
254
255	! !PRIVATE MEMBER FUNCTIONS:
256	module procedure ESMF_TimeLE
257
258	! !DESCRIPTION:
259	! This interface overloads the .LE. operator for the {\tt ESMF\_Time} class
260	!
261	!EOP
262	end interface
263	!
264	!------------------------------------------------------------------------------
265	!BOP
266	! !INTERFACE:
267	interface operator(.GE.)
268
269	! !PRIVATE MEMBER FUNCTIONS:
270	module procedure ESMF_TimeGE
271
272	! !DESCRIPTION:
273	! This interface overloads the .GE. operator for the {\tt ESMF\_Time} class
274	!
275	!EOP
276	end interface
277	!
278	!------------------------------------------------------------------------------
279
280	!==============================================================================
281
282	contains
283
284	!==============================================================================
285	!
286	! Generic Get/Set routines which use F90 optional arguments
287	!
288	!------------------------------------------------------------------------------
289	!BOP
290	! !IROUTINE: ESMF_TimeGet - Get value in user-specified units
291
292	! !INTERFACE:
293	subroutine ESMF_TimeGet(time, YY, YRl, MM, DD, D, Dl, H, M, S, Sl, MS, &
294	US, NS, d_, h_, m_, s_, ms_, us_, ns_, Sn, Sd, &
295	dayOfYear, dayOfYear_r8, dayOfYear_intvl, &
296	timeString, rc)
297
298	! !ARGUMENTS:
299	type(ESMF_Time), intent(in) :: time
300	integer, intent(out), optional :: YY
301	integer(ESMF_KIND_I8), intent(out), optional :: YRl
302	integer, intent(out), optional :: MM
303	integer, intent(out), optional :: DD
304	integer, intent(out), optional :: D
305	integer(ESMF_KIND_I8), intent(out), optional :: Dl
306	integer, intent(out), optional :: H
307	integer, intent(out), optional :: M
308	integer, intent(out), optional :: S
309	integer(ESMF_KIND_I8), intent(out), optional :: Sl
310	integer, intent(out), optional :: MS
311	integer, intent(out), optional :: US
312	integer, intent(out), optional :: NS
313	double precision, intent(out), optional :: d_
314	double precision, intent(out), optional :: h_
315	double precision, intent(out), optional :: m_
316	double precision, intent(out), optional :: s_
317	double precision, intent(out), optional :: ms_
318	double precision, intent(out), optional :: us_
319	double precision, intent(out), optional :: ns_
320	integer, intent(out), optional :: Sn
321	integer, intent(out), optional :: Sd
322	integer, intent(out), optional :: dayOfYear
323	! dayOfYear_r8 = 1.0 at 0Z on 1 January, 1.5 at 12Z on
324	! 1 January, etc.
325	real(ESMF_KIND_R8), intent(out), optional :: dayOfYear_r8
326	character (len=*), intent(out), optional :: timeString
327	type(ESMF_TimeInterval), intent(out), optional :: dayOfYear_intvl
328	integer, intent(out), optional :: rc
329
330	type(ESMF_TimeInterval) :: day_step
331	integer :: ierr
332
333	! !DESCRIPTION:
334	! Get the value of the {\tt ESMF\_Time} in units specified by the user
335	! via F90 optional arguments.
336	!
337	! Time manager represents and manipulates time internally with integers
338	! to maintain precision. Hence, user-specified floating point values are
339	! converted internally from integers.
340	!
341	! See {\tt ../include/ESMC\_BaseTime.h and ../include/ESMC\_Time.h} for
342	! complete description.
343	!
344	! The arguments are:
345	! \begin{description}
346	! \item[time]
347	! The object instance to query
348	! \item[{[YY]}]
349	! Integer year CCYR (>= 32-bit)
350	! \item[{[YRl]}]
351	! Integer year CCYR (large, >= 64-bit)
352	! \item[{[MM]}]
353	! Integer month 1-12
354	! \item[{[DD]}]
355	! Integer day of the month 1-31
356	! \item[{[D]}]
357	! Integer Julian days (>= 32-bit)
358	! \item[{[Dl]}]
359	! Integer Julian days (large, >= 64-bit)
360	! \item[{[H]}]
361	! Integer hours
362	! \item[{[M]}]
363	! Integer minutes
364	! \item[{[S]}]
365	! Integer seconds (>= 32-bit)
366	! \item[{[Sl]}]
367	! Integer seconds (large, >= 64-bit)
368	! \item[{[MS]}]
369	! Integer milliseconds
370	! \item[{[US]}]
371	! Integer microseconds
372	! \item[{[NS]}]
373	! Integer nanoseconds
374	! \item[{[d\_]}]
375	! Double precision days
376	! \item[{[h\_]}]
377	! Double precision hours
378	! \item[{[m\_]}]
379	! Double precision minutes
380	! \item[{[s\_]}]
381	! Double precision seconds
382	! \item[{[ms\_]}]
383	! Double precision milliseconds
384	! \item[{[us\_]}]
385	! Double precision microseconds
386	! \item[{[ns\_]}]
387	! Double precision nanoseconds
388	! \item[{[Sn]}]
389	! Integer fractional seconds - numerator
390	! \item[{[Sd]}]
391	! Integer fractional seconds - denominator
392	! \item[{[rc]}]
393	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
394	! \end{description}
395	!
396	! !REQUIREMENTS:
397	! TMG2.1, TMG2.5.1, TMG2.5.6
398	!EOP
399	TYPE(ESMF_Time) :: begofyear
400	INTEGER :: year, month, dayofmonth, hour, minute, second
401	REAL(ESMF_KIND_R8) :: rsec
402
403	ierr = ESMF_SUCCESS
404
405	IF ( PRESENT( YY ) ) THEN
406	YY = time%YR
407	ENDIF
408	IF ( PRESENT( MM ) ) THEN
409	CALL timegetmonth( time, MM )
410	ENDIF
411	IF ( PRESENT( DD ) ) THEN
412	CALL timegetdayofmonth( time, DD )
413	ENDIF
414	!
415	!$$$ Push HMS down into ESMF_BaseTime from EVERYWHERE
416	!$$$ and THEN add ESMF scaling behavior when other args are present...
417	IF ( PRESENT( H ) ) THEN
418	H = mod( time%basetime%S, SECONDS_PER_DAY ) / SECONDS_PER_HOUR
419	ENDIF
420	IF ( PRESENT( M ) ) THEN
421	M = mod( time%basetime%S, SECONDS_PER_HOUR) / SECONDS_PER_MINUTE
422	ENDIF
423	IF ( PRESENT( S ) ) THEN
424	S = mod( time%basetime%S, SECONDS_PER_MINUTE )
425	ENDIF
426	! TBH: HACK to allow DD and S to behave as in ESMF 2.1.0+ when
427	! TBH: both are present and H and M are not.
428	IF ( PRESENT( S ) .AND. PRESENT( DD ) ) THEN
429	IF ( ( .NOT. PRESENT( H ) ) .AND. ( .NOT. PRESENT( M ) ) ) THEN
430	S = mod( time%basetime%S, SECONDS_PER_DAY )
431	ENDIF
432	ENDIF
433	IF ( PRESENT( MS ) ) THEN
434	IF ( time%basetime%Sd /= 0 ) THEN
435	MS = NINT( ( time%basetime%Sn1.0D0 / time%basetime%Sd1.0D0 ) * 1000.0D0 )
436	ELSE
437	MS = 0
438	ENDIF
439	ENDIF
440	IF ( PRESENT( Sd ) .AND. PRESENT( Sn ) ) THEN
441	Sd = time%basetime%Sd
442	Sn = time%basetime%Sn
443	ENDIF
444	IF ( PRESENT( dayOfYear ) ) THEN
445	CALL ESMF_TimeGetDayOfYear( time, dayOfYear, rc=ierr )
446	ENDIF
447	IF ( PRESENT( dayOfYear_r8 ) ) THEN
448	! 64-bit IEEE 754 has 52-bit mantisssa -- only need 25 bits to hold
449	! number of seconds in a year...
450	rsec = REAL( time%basetime%S, ESMF_KIND_R8 )
451	IF ( time%basetime%Sd /= 0 ) THEN
452	rsec = rsec + ( REAL( time%basetime%Sn, ESMF_KIND_R8 ) / &
453	REAL( time%basetime%Sd, ESMF_KIND_R8 ) )
454	ENDIF
455	dayOfYear_r8 = rsec / REAL( SECONDS_PER_DAY, ESMF_KIND_R8 )
456	! start at 1
457	dayOfYear_r8 = dayOfYear_r8 + 1.0_ESMF_KIND_R8
458	ENDIF
459	IF ( PRESENT( timeString ) ) THEN
460	! This duplication for YMD is an optimization that avoids calling
461	! timegetmonth() and timegetdayofmonth() when it is not needed.
462	year = time%YR
463	CALL timegetmonth( time, month )
464	CALL timegetdayofmonth( time, dayofmonth )
465	!$$$ push HMS down into ESMF_BaseTime
466	hour = mod( time%basetime%S, SECONDS_PER_DAY ) / SECONDS_PER_HOUR
467	minute = mod( time%basetime%S, SECONDS_PER_HOUR) / SECONDS_PER_MINUTE
468	second = mod( time%basetime%S, SECONDS_PER_MINUTE )
469	CALL ESMFold_TimeGetString( year, month, dayofmonth, &
470	hour, minute, second, timeString )
471	ENDIF
472	IF ( PRESENT( dayOfYear_intvl ) ) THEN
473	year = time%YR
474	CALL ESMF_TimeSet( begofyear, yy=year, mm=1, dd=1, s=0, &
475	calendar=time%calendar, rc=ierr )
476	IF ( ierr == ESMF_FAILURE)THEN
477	rc = ierr
478	RETURN
479	END IF
480	CALL ESMF_TimeIntervalSet( day_step, d=1, s=0, rc=ierr )
481	dayOfYear_intvl = time - begofyear + day_step
482	ENDIF
483
484	IF ( PRESENT( rc ) ) THEN
485	rc = ierr
486	ENDIF
487
488	end subroutine ESMF_TimeGet
489
490	!------------------------------------------------------------------------------
491	!BOP
492	! !IROUTINE: ESMF_TimeSet - Initialize via user-specified unit set
493
494	! !INTERFACE:
495	subroutine ESMF_TimeSet(time, YY, YRl, MM, DD, D, Dl, H, M, S, Sl, &
496	MS, US, NS, d_, h_, m_, s_, ms_, us_, ns_, &
497	Sn, Sd, calendar, rc)
498
499	! !ARGUMENTS:
500	type(ESMF_Time), intent(inout) :: time
501	integer, intent(in), optional :: YY
502	integer(ESMF_KIND_I8), intent(in), optional :: YRl
503	integer, intent(in), optional :: MM
504	integer, intent(in), optional :: DD
505	integer, intent(in), optional :: D
506	integer(ESMF_KIND_I8), intent(in), optional :: Dl
507	integer, intent(in), optional :: H
508	integer, intent(in), optional :: M
509	integer, intent(in), optional :: S
510	integer(ESMF_KIND_I8), intent(in), optional :: Sl
511	integer, intent(in), optional :: MS
512	integer, intent(in), optional :: US
513	integer, intent(in), optional :: NS
514	double precision, intent(in), optional :: d_
515	double precision, intent(in), optional :: h_
516	double precision, intent(in), optional :: m_
517	double precision, intent(in), optional :: s_
518	double precision, intent(in), optional :: ms_
519	double precision, intent(in), optional :: us_
520	double precision, intent(in), optional :: ns_
521	integer, intent(in), optional :: Sn
522	integer, intent(in), optional :: Sd
523	type(ESMF_Calendar), intent(in), target, optional :: calendar
524	integer, intent(out), optional :: rc
525	! locals
526	INTEGER :: ierr
527
528	! !DESCRIPTION:
529	! Initializes a {\tt ESMF\_Time} with a set of user-specified units
530	! via F90 optional arguments.
531	!
532	! Time manager represents and manipulates time internally with integers
533	! to maintain precision. Hence, user-specified floating point values are
534	! converted internally to integers.
535	!
536	! See {\tt ../include/ESMC\_BaseTime.h and ../include/ESMC\_Time.h} for
537	! complete description.
538	!
539	! The arguments are:
540	! \begin{description}
541	! \item[time]
542	! The object instance to initialize
543	! \item[{[YY]}]
544	! Integer year CCYR (>= 32-bit)
545	! \item[{[YRl]}]
546	! Integer year CCYR (large, >= 64-bit)
547	! \item[{[MM]}]
548	! Integer month 1-12
549	! \item[{[DD]}]
550	! Integer day of the month 1-31
551	! \item[{[D]}]
552	! Integer Julian days (>= 32-bit)
553	! \item[{[Dl]}]
554	! Integer Julian days (large, >= 64-bit)
555	! \item[{[H]}]
556	! Integer hours
557	! \item[{[M]}]
558	! Integer minutes
559	! \item[{[S]}]
560	! Integer seconds (>= 32-bit)
561	! \item[{[Sl]}]
562	! Integer seconds (large, >= 64-bit)
563	! \item[{[MS]}]
564	! Integer milliseconds
565	! \item[{[US]}]
566	! Integer microseconds
567	! \item[{[NS]}]
568	! Integer nanoseconds
569	! \item[{[d\_]}]
570	! Double precision days
571	! \item[{[h\_]}]
572	! Double precision hours
573	! \item[{[m\_]}]
574	! Double precision minutes
575	! \item[{[s\_]}]
576	! Double precision seconds
577	! \item[{[ms\_]}]
578	! Double precision milliseconds
579	! \item[{[us\_]}]
580	! Double precision microseconds
581	! \item[{[ns\_]}]
582	! Double precision nanoseconds
583	! \item[{[Sn]}]
584	! Integer fractional seconds - numerator
585	! \item[{[Sd]}]
586	! Integer fractional seconds - denominator
587	! \item[{[cal]}]
588	! Associated {\tt Calendar}
589	! \item[{[tz]}]
590	! Associated timezone (hours offset from GMT, e.g. EST = -5)
591	! \item[{[rc]}]
592	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
593	! \end{description}
594	!
595	! !REQUIREMENTS:
596	! TMGn.n.n
597	!EOP
598	! PRINT *,'DEBUG: BEGIN ESMF_TimeSet()'
599	!$$$ push this down into ESMF_BaseTime constructor
600	time%basetime%S = 0
601	time%basetime%Sn = 0
602	time%basetime%Sd = 0
603
604	IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
605	time%YR = 0
606	IF ( PRESENT( YY ) ) THEN
607	! PRINT *,'DEBUG: ESMF_TimeSet(): YY = ',YY
608	time%YR = YY
609	ENDIF
610	IF ( PRESENT( MM ) ) THEN
611	! PRINT *,'DEBUG: ESMF_TimeSet(): MM = ',MM
612	CALL timeaddmonths( time, MM, ierr )
613	IF ( ierr == ESMF_FAILURE ) THEN
614	IF ( PRESENT( rc ) ) THEN
615	rc = ESMF_FAILURE
616	RETURN
617	ELSE
618	CALL wrf_error_fatal( 'ESMF_TimeSet: MM out of range' )
619	ENDIF
620	ENDIF
621	! PRINT *,'DEBUG: ESMF_TimeSet(): back from timeaddmonths'
622	ENDIF
623	IF ( PRESENT( DD ) ) THEN
624	!$$$ no check for DD in range of days of month MM yet
625	!$$$ Must separate D and DD for correct interface!
626	! PRINT *,'DEBUG: ESMF_TimeSet(): DD = ',DD
627	time%basetime%S = time%basetime%S + &
628	( SECONDS_PER_DAY * INT( (DD-1), ESMF_KIND_I8 ) )
629	ENDIF
630	!$$$ push H,M,S,Sn,Sd,MS down into ESMF_BaseTime constructor
631	IF ( PRESENT( H ) ) THEN
632	! PRINT *,'DEBUG: ESMF_TimeSet(): H = ',H
633	time%basetime%S = time%basetime%S + &
634	( SECONDS_PER_HOUR * INT( H, ESMF_KIND_I8 ) )
635	ENDIF
636	IF ( PRESENT( M ) ) THEN
637	! PRINT *,'DEBUG: ESMF_TimeSet(): M = ',M
638	time%basetime%S = time%basetime%S + &
639	( SECONDS_PER_MINUTE * INT( M, ESMF_KIND_I8 ) )
640	ENDIF
641	IF ( PRESENT( S ) ) THEN
642	! PRINT *,'DEBUG: ESMF_TimeSet(): S = ',S
643	time%basetime%S = time%basetime%S + &
644	INT( S, ESMF_KIND_I8 )
645	ENDIF
646	IF ( PRESENT( Sn ) .AND. ( .NOT. PRESENT( Sd ) ) ) THEN
647	CALL wrf_error_fatal( &
648	"ESMF_TimeSet: Must specify Sd if Sn is specified")
649	ENDIF
650	IF ( PRESENT( Sd ) .AND. PRESENT( MS ) ) THEN
651	CALL wrf_error_fatal( &
652	"ESMF_TimeSet: Must not specify both Sd and MS")
653	ENDIF
654	time%basetime%Sn = 0
655	time%basetime%Sd = 0
656	IF ( PRESENT( MS ) ) THEN
657	! PRINT *,'DEBUG: ESMF_TimeSet(): MS = ',MS
658	time%basetime%Sn = MS
659	time%basetime%Sd = 1000_ESMF_KIND_I8
660	ELSE IF ( PRESENT( Sd ) ) THEN
661	! PRINT *,'DEBUG: ESMF_TimeSet(): Sd = ',Sd
662	time%basetime%Sd = Sd
663	IF ( PRESENT( Sn ) ) THEN
664	! PRINT *,'DEBUG: ESMF_TimeSet(): Sn = ',Sn
665	time%basetime%Sn = Sn
666	ENDIF
667	ENDIF
668	IF ( PRESENT(calendar) )THEN
669	! PRINT *,'DEBUG: ESMF_TimeSet(): using passed-in calendar'
670	! Note that the ugly hack of wrapping the call to ESMF_CalendarInitialized()
671	! inside this #ifdef is due to lack of support for compile-time initialization
672	! of components of Fortran derived types. Some older compilers like PGI 5.1-x
673	! do not support this F95 feature. In this case we only lose a safety check.
674	#ifndef NO_DT_COMPONENT_INIT
675	IF ( .not. ESMF_CalendarInitialized( calendar ) )THEN
676	call wrf_error_fatal( "Error:: ESMF_CalendarCreate not "// &
677	"called on input Calendar")
678	END IF
679	#endif
680	time%Calendar => calendar
681	ELSE
682	! PRINT *,'DEBUG: ESMF_TimeSet(): using default calendar'
683	IF ( .not. ESMF_IsInitialized() )THEN
684	call wrf_error_fatal( "Error:: ESMF_Initialize not called")
685	END IF
686	time%Calendar => defaultCal
687	END IF
688
689	! PRINT *,'DEBUG: ESMF_TimeSet(): calling normalize_time()'
690	!$$$DEBUG
691	!IF ( time%basetime%Sd > 0 ) THEN
692	! PRINT *,'DEBUG ESMF_TimeSet() before normalize: S,Sn,Sd = ', &
693	! time%basetime%S, time%basetime%Sn, time%basetime%Sd
694	!ENDIF
695	!$$$END DEBUG
696	CALL normalize_time( time )
697	!$$$DEBUG
698	!IF ( time%basetime%Sd > 0 ) THEN
699	! PRINT *,'DEBUG ESMF_TimeSet() after normalize: S,Sn,Sd = ', &
700	! time%basetime%S, time%basetime%Sn, time%basetime%Sd
701	!ENDIF
702	!$$$END DEBUG
703
704	! PRINT *,'DEBUG: ESMF_TimeSet(): back from normalize_time()'
705	IF ( PRESENT( rc ) ) THEN
706	rc = ESMF_SUCCESS
707	ENDIF
708
709	end subroutine ESMF_TimeSet
710
711	!------------------------------------------------------------------------------
712	!BOP
713	! !IROUTINE: ESMFold_TimeGetString - Get time instant value in string format
714
715	! !INTERFACE:
716	subroutine ESMFold_TimeGetString( year, month, dayofmonth, &
717	hour, minute, second, TimeString )
718
719	! !ARGUMENTS:
720	integer, intent(in) :: year
721	integer, intent(in) :: month
722	integer, intent(in) :: dayofmonth
723	integer, intent(in) :: hour
724	integer, intent(in) :: minute
725	integer, intent(in) :: second
726	character(), intent(out) :: TimeString
727	! !DESCRIPTION:
728	! Convert {\tt ESMF\_Time}'s value into ISO 8601 format YYYY-MM-DDThh:mm:ss
729	!
730	! The arguments are:
731	! \begin{description}
732	! \item[time]
733	! The object instance to convert
734	! \item[TimeString]
735	! The string to return
736	! \item[{[rc]}]
737	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
738	! \end{description}
739	!
740	! !REQUIREMENTS:
741	! TMG2.4.7
742	!EOP
743
744	!PRINT *,'DEBUG: ESMF_TimePrint(): YR,S,Sn,Sd = ',time%YR,time%basetime%S,time%basetime%Sn,time%basetime%Sd
745	!PRINT *,'DEBUG: ESMF_TimePrint(): year = ',year
746	!PRINT *,'DEBUG: ESMF_TimePrint(): month, dayofmonth = ',month,dayofmonth
747	!PRINT *,'DEBUG: ESMF_TimePrint(): hour = ',hour
748	!PRINT *,'DEBUG: ESMF_TimePrint(): minute = ',minute
749	!PRINT *,'DEBUG: ESMF_TimePrint(): second = ',second
750
751	!$$$here... add negative sign for YR<0
752	!$$$here... add Sn, Sd ??
753	write(TimeString,FMT="(I4.4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)") &
754	year,month,dayofmonth,hour,minute,second
755
756	end subroutine ESMFold_TimeGetString
757
758	!------------------------------------------------------------------------------
759	!BOP
760	! !IROUTINE: ESMF_TimeGetDayOfYearInteger - Get time instant's day of the year as an integer value
761	!
762	! !INTERFACE:
763	subroutine ESMF_TimeGetDayOfYearInteger(time, DayOfYear, rc)
764	!
765	! !ARGUMENTS:
766	type(ESMF_Time), intent(in) :: time
767	integer, intent(out) :: DayOfYear
768	integer, intent(out), optional :: rc
769	!
770	! !DESCRIPTION:
771	! Get the day of the year the given {\tt ESMF\_Time} instant falls on
772	! (1-365). Returned as an integer value
773	!
774	! The arguments are:
775	! \begin{description}
776	! \item[time]
777	! The object instance to query
778	! \item[DayOfYear]
779	! The {\tt ESMF\_Time} instant's day of the year (1-365)
780	! \item[{[rc]}]
781	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
782	! \end{description}
783	!
784	! !REQUIREMENTS:
785	!EOP
786	! requires that time be normalized
787	!$$$ bug when Sn>0? test
788	!$$$ add tests
789	DayOfYear = ( time%basetime%S / SECONDS_PER_DAY ) + 1
790	IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
791	end subroutine ESMF_TimeGetDayOfYearInteger
792
793	!------------------------------------------------------------------------------
794	!BOP
795	! !IROUTINE: ESMF_TimeInc - Increment time instant with a time interval
796	!
797	! !INTERFACE:
798	function ESMF_TimeInc(time, timeinterval)
799	!
800	! !RETURN VALUE:
801	type(ESMF_Time) :: ESMF_TimeInc
802	!
803	! !ARGUMENTS:
804	type(ESMF_Time), intent(in) :: time
805	type(ESMF_TimeInterval), intent(in) :: timeinterval
806	! !LOCAL:
807	integer :: rc
808	!
809	! !DESCRIPTION:
810	! Increment {\tt ESMF\_Time} instant with a {\tt ESMF\_TimeInterval},
811	! return resulting {\tt ESMF\_Time} instant
812	!
813	! Maps overloaded (+) operator interface function to
814	! {\tt ESMF\_BaseTime} base class
815	!
816	! The arguments are:
817	! \begin{description}
818	! \item[time]
819	! The given {\tt ESMF\_Time} to increment
820	! \item[timeinterval]
821	! The {\tt ESMF\_TimeInterval} to add to the given {\tt ESMF\_Time}
822	! \end{description}
823	!
824	! !REQUIREMENTS:
825	! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
826	!EOP
827
828	! copy ESMF_Time specific properties (e.g. calendar, timezone)
829	ESMF_TimeInc = time
830
831	! call ESMC_BaseTime base class function
832	call c_ESMC_BaseTimeSum(time, timeinterval, ESMF_TimeInc)
833
834	end function ESMF_TimeInc
835	!
836	! this is added for certain compilers that don't deal with commutativity
837	!
838	function ESMF_TimeInc2(timeinterval, time)
839	type(ESMF_Time) :: ESMF_TimeInc2
840	type(ESMF_Time), intent(in) :: time
841	type(ESMF_TimeInterval), intent(in) :: timeinterval
842	ESMF_TimeInc2 = ESMF_TimeInc( time, timeinterval )
843	end function ESMF_TimeInc2
844	!
845
846	!------------------------------------------------------------------------------
847	!BOP
848	! !IROUTINE: ESMF_TimeDec - Decrement time instant with a time interval
849	!
850	! !INTERFACE:
851	function ESMF_TimeDec(time, timeinterval)
852	!
853	! !RETURN VALUE:
854	type(ESMF_Time) :: ESMF_TimeDec
855	!
856	! !ARGUMENTS:
857	type(ESMF_Time), intent(in) :: time
858	type(ESMF_TimeInterval), intent(in) :: timeinterval
859	! !LOCAL:
860	integer :: rc
861	!
862	! !DESCRIPTION:
863	! Decrement {\tt ESMF\_Time} instant with a {\tt ESMF\_TimeInterval},
864	! return resulting {\tt ESMF\_Time} instant
865	!
866	! Maps overloaded (-) operator interface function to
867	! {\tt ESMF\_BaseTime} base class
868	!
869	! The arguments are:
870	! \begin{description}
871	! \item[time]
872	! The given {\tt ESMF\_Time} to decrement
873	! \item[timeinterval]
874	! The {\tt ESMF\_TimeInterval} to subtract from the given
875	! {\tt ESMF\_Time}
876	! \end{description}
877	!
878	! !REQUIREMENTS:
879	! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
880	!EOP
881
882	! copy ESMF_Time specific properties (e.g. calendar, timezone)
883	ESMF_TimeDec = time
884
885	! call ESMC_BaseTime base class function
886	call c_ESMC_BaseTimeDec(time, timeinterval, ESMF_TimeDec)
887
888	end function ESMF_TimeDec
889
890	!
891	! this is added for certain compilers that don't deal with commutativity
892	!
893	function ESMF_TimeDec2(timeinterval, time)
894	type(ESMF_Time) :: ESMF_TimeDec2
895	type(ESMF_Time), intent(in) :: time
896	type(ESMF_TimeInterval), intent(in) :: timeinterval
897	ESMF_TimeDec2 = ESMF_TimeDec( time, timeinterval )
898	end function ESMF_TimeDec2
899	!
900	!------------------------------------------------------------------------------
901	!BOP
902	! !IROUTINE: ESMF_TimeDiff - Return the difference between two time instants
903	!
904	! !INTERFACE:
905	function ESMF_TimeDiff(time1, time2)
906	!
907	! !RETURN VALUE:
908	type(ESMF_TimeInterval) :: ESMF_TimeDiff
909	!
910	! !ARGUMENTS:
911	type(ESMF_Time), intent(in) :: time1
912	type(ESMF_Time), intent(in) :: time2
913	! !LOCAL:
914	integer :: rc
915
916	! !DESCRIPTION:
917	! Return the {\tt ESMF\_TimeInterval} difference between two
918	! {\tt ESMF\_Time} instants
919	!
920	! Maps overloaded (-) operator interface function to
921	! {\tt ESMF\_BaseTime} base class
922	!
923	! The arguments are:
924	! \begin{description}
925	! \item[time1]
926	! The first {\tt ESMF\_Time} instant
927	! \item[time2]
928	! The second {\tt ESMF\_Time} instant
929	! \end{description}
930	!
931	! !REQUIREMENTS:
932	! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
933	!EOP
934
935	! call ESMC_BaseTime base class function
936	CALL ESMF_TimeIntervalSet( ESMF_TimeDiff, rc=rc )
937	call c_ESMC_BaseTimeDiff(time1, time2, ESMF_TimeDiff)
938
939	end function ESMF_TimeDiff
940
941	!------------------------------------------------------------------------------
942	!BOP
943	! !IROUTINE: ESMF_TimeEQ - Compare two times for equality
944	!
945	! !INTERFACE:
946	function ESMF_TimeEQ(time1, time2)
947	!
948	! !RETURN VALUE:
949	logical :: ESMF_TimeEQ
950	!
951	! !ARGUMENTS:
952	type(ESMF_Time), intent(in) :: time1
953	type(ESMF_Time), intent(in) :: time2
954	!
955	! !DESCRIPTION:
956	! Return true if both given {\tt ESMF\_Time} instants are equal, false
957	! otherwise. Maps overloaded (==) operator interface function to
958	! {\tt ESMF\_BaseTime} base class.
959	!
960	! The arguments are:
961	! \begin{description}
962	! \item[time1]
963	! First time instant to compare
964	! \item[time2]
965	! Second time instant to compare
966	! \end{description}
967	!
968	! !REQUIREMENTS:
969	! TMG1.5.3, TMG2.4.3, TMG7.2
970	!EOP
971
972	! invoke C to C++ entry point for ESMF_BaseTime base class function
973	call c_ESMC_BaseTimeEQ(time1, time2, ESMF_TimeEQ)
974
975	end function ESMF_TimeEQ
976
977	!------------------------------------------------------------------------------
978	!BOP
979	! !IROUTINE: ESMF_TimeNE - Compare two times for non-equality
980	!
981	! !INTERFACE:
982	function ESMF_TimeNE(time1, time2)
983	!
984	! !RETURN VALUE:
985	logical :: ESMF_TimeNE
986	!
987	! !ARGUMENTS:
988	type(ESMF_Time), intent(in) :: time1
989	type(ESMF_Time), intent(in) :: time2
990
991	! !DESCRIPTION:
992	! Return true if both given {\tt ESMF\_Time} instants are not equal, false
993	! otherwise. Maps overloaded (/=) operator interface function to
994	! {\tt ESMF\_BaseTime} base class.
995	!
996	! The arguments are:
997	! \begin{description}
998	! \item[time1]
999	! First time instant to compare
1000	! \item[time2]
1001	! Second time instant to compare
1002	! \end{description}
1003	!
1004	! !REQUIREMENTS:
1005	! TMG1.5.3, TMG2.4.3, TMG7.2
1006	!EOP
1007
1008	! call ESMC_BaseTime base class function
1009	call c_ESMC_BaseTimeNE(time1, time2, ESMF_TimeNE)
1010
1011	end function ESMF_TimeNE
1012
1013	!------------------------------------------------------------------------------
1014	!BOP
1015	! !IROUTINE: ESMF_TimeLT - Time instant 1 less than time instant 2 ?
1016	!
1017	! !INTERFACE:
1018	function ESMF_TimeLT(time1, time2)
1019	!
1020	! !RETURN VALUE:
1021	logical :: ESMF_TimeLT
1022	!
1023	! !ARGUMENTS:
1024	type(ESMF_Time), intent(in) :: time1
1025	type(ESMF_Time), intent(in) :: time2
1026	!
1027	! !DESCRIPTION:
1028	! Return true if first {\tt ESMF\_Time} instant is less than second
1029	! {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (<)
1030	! operator interface function to {\tt ESMF\_BaseTime} base class.
1031	!
1032	! The arguments are:
1033	! \begin{description}
1034	! \item[time1]
1035	! First time instant to compare
1036	! \item[time2]
1037	! Second time instant to compare
1038	! \end{description}
1039	!
1040	! !REQUIREMENTS:
1041	! TMG1.5.3, TMG2.4.3, TMG7.2
1042	!EOP
1043
1044	! call ESMC_BaseTime base class function
1045	call c_ESMC_BaseTimeLT(time1, time2, ESMF_TimeLT)
1046
1047	end function ESMF_TimeLT
1048
1049	!------------------------------------------------------------------------------
1050	!BOP
1051	! !IROUTINE: ESMF_TimeGT - Time instant 1 greater than time instant 2 ?
1052	!
1053	! !INTERFACE:
1054	function ESMF_TimeGT(time1, time2)
1055	!
1056	! !RETURN VALUE:
1057	logical :: ESMF_TimeGT
1058	!
1059	! !ARGUMENTS:
1060	type(ESMF_Time), intent(in) :: time1
1061	type(ESMF_Time), intent(in) :: time2
1062	!
1063	! !DESCRIPTION:
1064	! Return true if first {\tt ESMF\_Time} instant is greater than second
1065	! {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (>) operator
1066	! interface function to {\tt ESMF\_BaseTime} base class.
1067	!
1068	! The arguments are:
1069	! \begin{description}
1070	! \item[time1]
1071	! First time instant to compare
1072	! \item[time2]
1073	! Second time instant to compare
1074	! \end{description}
1075	!
1076	! !REQUIREMENTS:
1077	! TMG1.5.3, TMG2.4.3, TMG7.2
1078	!EOP
1079
1080	! call ESMC_BaseTime base class function
1081	call c_ESMC_BaseTimeGT(time1, time2, ESMF_TimeGT)
1082
1083	end function ESMF_TimeGT
1084
1085	!------------------------------------------------------------------------------
1086	!BOP
1087	! !IROUTINE: ESMF_TimeLE - Time instant 1 less than or equal to time instant 2 ?
1088	!
1089	! !INTERFACE:
1090	function ESMF_TimeLE(time1, time2)
1091	!
1092	! !RETURN VALUE:
1093	logical :: ESMF_TimeLE
1094	!
1095	! !ARGUMENTS:
1096	type(ESMF_Time), intent(in) :: time1
1097	type(ESMF_Time), intent(in) :: time2
1098	!
1099	! !DESCRIPTION:
1100	! Return true if first {\tt ESMF\_Time} instant is less than or equal to
1101	! second {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (<=)
1102	! operator interface function to {\tt ESMF\_BaseTime} base class.
1103	!
1104	! The arguments are:
1105	! \begin{description}
1106	! \item[time1]
1107	! First time instant to compare
1108	! \item[time2]
1109	! Second time instant to compare
1110	! \end{description}
1111	!
1112	! !REQUIREMENTS:
1113	! TMG1.5.3, TMG2.4.3, TMG7.2
1114	!EOP
1115
1116	! call ESMC_BaseTime base class function
1117	call c_ESMC_BaseTimeLE(time1, time2, ESMF_TimeLE)
1118
1119	end function ESMF_TimeLE
1120
1121	!------------------------------------------------------------------------------
1122	!BOP
1123	! !IROUTINE: ESMF_TimeGE - Time instant 1 greater than or equal to time instant 2 ?
1124	!
1125	! !INTERFACE:
1126	function ESMF_TimeGE(time1, time2)
1127	!
1128	! !RETURN VALUE:
1129	logical :: ESMF_TimeGE
1130	!
1131	! !ARGUMENTS:
1132	type(ESMF_Time), intent(in) :: time1
1133	type(ESMF_Time), intent(in) :: time2
1134	!
1135	! !DESCRIPTION:
1136	! Return true if first {\tt ESMF\_Time} instant is greater than or equal to
1137	! second {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (>=)
1138	! operator interface function to {\tt ESMF\_BaseTime} base class.
1139	!
1140	! The arguments are:
1141	! \begin{description}
1142	! \item[time1]
1143	! First time instant to compare
1144	! \item[time2]
1145	! Second time instant to compare
1146	! \end{description}
1147	!
1148	! !REQUIREMENTS:
1149	! TMG1.5.3, TMG2.4.3, TMG7.2
1150	!EOP
1151
1152	! call ESMC_BaseTime base class function
1153	call c_ESMC_BaseTimeGE(time1, time2, ESMF_TimeGE)
1154
1155	end function ESMF_TimeGE
1156
1157	!------------------------------------------------------------------------------
1158	!BOP
1159	! !IROUTINE: ESMF_TimeCopy - Copy a time-instance
1160
1161	! !INTERFACE:
1162	subroutine ESMF_TimeCopy(timeout, timein)
1163
1164	! !ARGUMENTS:
1165	type(ESMF_Time), intent(out) :: timeout
1166	type(ESMF_Time), intent(in) :: timein
1167
1168	! !DESCRIPTION:
1169	! Copy a time-instance to a new instance.
1170	!
1171	! \item[{[rc]}]
1172	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
1173	! \end{description}
1174	!
1175	! !REQUIREMENTS:
1176	! TMGn.n.n
1177	!EOP
1178
1179	timeout%basetime = timein%basetime
1180	timeout%YR = timein%YR
1181	timeout%Calendar => timein%Calendar
1182
1183	end subroutine ESMF_TimeCopy
1184
1185	end module ESMF_TimeMod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format