Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

ESMF_Time.F90 @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 35.7 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 University of Illinois-NCSA license.
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	ENDIF
618	ENDIF
619	! PRINT *,'DEBUG: ESMF_TimeSet(): back from timeaddmonths'
620	ENDIF
621	IF ( PRESENT( DD ) ) THEN
622	!$$$ no check for DD in range of days of month MM yet
623	!$$$ Must separate D and DD for correct interface!
624	! PRINT *,'DEBUG: ESMF_TimeSet(): DD = ',DD
625	time%basetime%S = time%basetime%S + &
626	( SECONDS_PER_DAY * INT( (DD-1), ESMF_KIND_I8 ) )
627	ENDIF
628	!$$$ push H,M,S,Sn,Sd,MS down into ESMF_BaseTime constructor
629	IF ( PRESENT( H ) ) THEN
630	! PRINT *,'DEBUG: ESMF_TimeSet(): H = ',H
631	time%basetime%S = time%basetime%S + &
632	( SECONDS_PER_HOUR * INT( H, ESMF_KIND_I8 ) )
633	ENDIF
634	IF ( PRESENT( M ) ) THEN
635	! PRINT *,'DEBUG: ESMF_TimeSet(): M = ',M
636	time%basetime%S = time%basetime%S + &
637	( SECONDS_PER_MINUTE * INT( M, ESMF_KIND_I8 ) )
638	ENDIF
639	IF ( PRESENT( S ) ) THEN
640	! PRINT *,'DEBUG: ESMF_TimeSet(): S = ',S
641	time%basetime%S = time%basetime%S + &
642	INT( S, ESMF_KIND_I8 )
643	ENDIF
644	IF ( PRESENT( Sn ) .AND. ( .NOT. PRESENT( Sd ) ) ) THEN
645	CALL wrf_error_fatal( &
646	"ESMF_TimeSet: Must specify Sd if Sn is specified")
647	ENDIF
648	IF ( PRESENT( Sd ) .AND. PRESENT( MS ) ) THEN
649	CALL wrf_error_fatal( &
650	"ESMF_TimeSet: Must not specify both Sd and MS")
651	ENDIF
652	time%basetime%Sn = 0
653	time%basetime%Sd = 0
654	IF ( PRESENT( MS ) ) THEN
655	! PRINT *,'DEBUG: ESMF_TimeSet(): MS = ',MS
656	time%basetime%Sn = MS
657	time%basetime%Sd = 1000_ESMF_KIND_I8
658	ELSE IF ( PRESENT( Sd ) ) THEN
659	! PRINT *,'DEBUG: ESMF_TimeSet(): Sd = ',Sd
660	time%basetime%Sd = Sd
661	IF ( PRESENT( Sn ) ) THEN
662	! PRINT *,'DEBUG: ESMF_TimeSet(): Sn = ',Sn
663	time%basetime%Sn = Sn
664	ENDIF
665	ENDIF
666	IF ( PRESENT(calendar) )THEN
667	! PRINT *,'DEBUG: ESMF_TimeSet(): using passed-in calendar'
668	! Note that the ugly hack of wrapping the call to ESMF_CalendarInitialized()
669	! inside this #ifdef is due to lack of support for compile-time initialization
670	! of components of Fortran derived types. Some older compilers like PGI 5.1-x
671	! do not support this F95 feature. In this case we only lose a safety check.
672	#ifndef NO_DT_COMPONENT_INIT
673	IF ( .not. ESMF_CalendarInitialized( calendar ) )THEN
674	call wrf_error_fatal( "Error:: ESMF_CalendarCreate not "// &
675	"called on input Calendar")
676	END IF
677	#endif
678	time%Calendar => calendar
679	ELSE
680	! PRINT *,'DEBUG: ESMF_TimeSet(): using default calendar'
681	IF ( .not. ESMF_IsInitialized() )THEN
682	call wrf_error_fatal( "Error:: ESMF_Initialize not called")
683	END IF
684	time%Calendar => defaultCal
685	END IF
686
687	! PRINT *,'DEBUG: ESMF_TimeSet(): calling normalize_time()'
688	!$$$DEBUG
689	!IF ( time%basetime%Sd > 0 ) THEN
690	! PRINT *,'DEBUG ESMF_TimeSet() before normalize: S,Sn,Sd = ', &
691	! time%basetime%S, time%basetime%Sn, time%basetime%Sd
692	!ENDIF
693	!$$$END DEBUG
694	CALL normalize_time( time )
695	!$$$DEBUG
696	!IF ( time%basetime%Sd > 0 ) THEN
697	! PRINT *,'DEBUG ESMF_TimeSet() after normalize: S,Sn,Sd = ', &
698	! time%basetime%S, time%basetime%Sn, time%basetime%Sd
699	!ENDIF
700	!$$$END DEBUG
701
702	! PRINT *,'DEBUG: ESMF_TimeSet(): back from normalize_time()'
703	IF ( PRESENT( rc ) ) THEN
704	rc = ESMF_SUCCESS
705	ENDIF
706
707	end subroutine ESMF_TimeSet
708
709	!------------------------------------------------------------------------------
710	!BOP
711	! !IROUTINE: ESMFold_TimeGetString - Get time instant value in string format
712
713	! !INTERFACE:
714	subroutine ESMFold_TimeGetString( year, month, dayofmonth, &
715	hour, minute, second, TimeString )
716
717	! !ARGUMENTS:
718	integer, intent(in) :: year
719	integer, intent(in) :: month
720	integer, intent(in) :: dayofmonth
721	integer, intent(in) :: hour
722	integer, intent(in) :: minute
723	integer, intent(in) :: second
724	character(), intent(out) :: TimeString
725	! !DESCRIPTION:
726	! Convert {\tt ESMF\_Time}'s value into ISO 8601 format YYYY-MM-DDThh:mm:ss
727	!
728	! The arguments are:
729	! \begin{description}
730	! \item[time]
731	! The object instance to convert
732	! \item[TimeString]
733	! The string to return
734	! \item[{[rc]}]
735	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
736	! \end{description}
737	!
738	! !REQUIREMENTS:
739	! TMG2.4.7
740	!EOP
741
742	!PRINT *,'DEBUG: ESMF_TimePrint(): YR,S,Sn,Sd = ',time%YR,time%basetime%S,time%basetime%Sn,time%basetime%Sd
743	!PRINT *,'DEBUG: ESMF_TimePrint(): year = ',year
744	!PRINT *,'DEBUG: ESMF_TimePrint(): month, dayofmonth = ',month,dayofmonth
745	!PRINT *,'DEBUG: ESMF_TimePrint(): hour = ',hour
746	!PRINT *,'DEBUG: ESMF_TimePrint(): minute = ',minute
747	!PRINT *,'DEBUG: ESMF_TimePrint(): second = ',second
748
749	!$$$here... add negative sign for YR<0
750	!$$$here... add Sn, Sd ??
751	#ifdef PLANET
752	write(TimeString,FMT="(I4.4,'-',I5.5,'_',I2.2,':',I2.2,':',I2.2)") &
753	year,dayofmonth,hour,minute,second
754	#else
755	write(TimeString,FMT="(I4.4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)") &
756	year,month,dayofmonth,hour,minute,second
757	#endif
758
759	end subroutine ESMFold_TimeGetString
760
761	!------------------------------------------------------------------------------
762	!BOP
763	! !IROUTINE: ESMF_TimeGetDayOfYearInteger - Get time instant's day of the year as an integer value
764	!
765	! !INTERFACE:
766	subroutine ESMF_TimeGetDayOfYearInteger(time, DayOfYear, rc)
767	!
768	! !ARGUMENTS:
769	type(ESMF_Time), intent(in) :: time
770	integer, intent(out) :: DayOfYear
771	integer, intent(out), optional :: rc
772	!
773	! !DESCRIPTION:
774	! Get the day of the year the given {\tt ESMF\_Time} instant falls on
775	! (1-365). Returned as an integer value
776	!
777	! The arguments are:
778	! \begin{description}
779	! \item[time]
780	! The object instance to query
781	! \item[DayOfYear]
782	! The {\tt ESMF\_Time} instant's day of the year (1-365)
783	! \item[{[rc]}]
784	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
785	! \end{description}
786	!
787	! !REQUIREMENTS:
788	!EOP
789	! requires that time be normalized
790	!$$$ bug when Sn>0? test
791	!$$$ add tests
792	DayOfYear = ( time%basetime%S / SECONDS_PER_DAY ) + 1
793	IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
794	end subroutine ESMF_TimeGetDayOfYearInteger
795
796	!------------------------------------------------------------------------------
797	!BOP
798	! !IROUTINE: ESMF_TimeInc - Increment time instant with a time interval
799	!
800	! !INTERFACE:
801	function ESMF_TimeInc(time, timeinterval)
802	!
803	! !RETURN VALUE:
804	type(ESMF_Time) :: ESMF_TimeInc
805	!
806	! !ARGUMENTS:
807	type(ESMF_Time), intent(in) :: time
808	type(ESMF_TimeInterval), intent(in) :: timeinterval
809	! !LOCAL:
810	integer :: rc
811	!
812	! !DESCRIPTION:
813	! Increment {\tt ESMF\_Time} instant with a {\tt ESMF\_TimeInterval},
814	! return resulting {\tt ESMF\_Time} instant
815	!
816	! Maps overloaded (+) operator interface function to
817	! {\tt ESMF\_BaseTime} base class
818	!
819	! The arguments are:
820	! \begin{description}
821	! \item[time]
822	! The given {\tt ESMF\_Time} to increment
823	! \item[timeinterval]
824	! The {\tt ESMF\_TimeInterval} to add to the given {\tt ESMF\_Time}
825	! \end{description}
826	!
827	! !REQUIREMENTS:
828	! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
829	!EOP
830
831	! copy ESMF_Time specific properties (e.g. calendar, timezone)
832	ESMF_TimeInc = time
833
834	! call ESMC_BaseTime base class function
835	call c_ESMC_BaseTimeSum(time, timeinterval, ESMF_TimeInc)
836
837	end function ESMF_TimeInc
838	!
839	! this is added for certain compilers that don't deal with commutativity
840	!
841	function ESMF_TimeInc2(timeinterval, time)
842	type(ESMF_Time) :: ESMF_TimeInc2
843	type(ESMF_Time), intent(in) :: time
844	type(ESMF_TimeInterval), intent(in) :: timeinterval
845	ESMF_TimeInc2 = ESMF_TimeInc( time, timeinterval )
846	end function ESMF_TimeInc2
847	!
848
849	!------------------------------------------------------------------------------
850	!BOP
851	! !IROUTINE: ESMF_TimeDec - Decrement time instant with a time interval
852	!
853	! !INTERFACE:
854	function ESMF_TimeDec(time, timeinterval)
855	!
856	! !RETURN VALUE:
857	type(ESMF_Time) :: ESMF_TimeDec
858	!
859	! !ARGUMENTS:
860	type(ESMF_Time), intent(in) :: time
861	type(ESMF_TimeInterval), intent(in) :: timeinterval
862	! !LOCAL:
863	integer :: rc
864	!
865	! !DESCRIPTION:
866	! Decrement {\tt ESMF\_Time} instant with a {\tt ESMF\_TimeInterval},
867	! return resulting {\tt ESMF\_Time} instant
868	!
869	! Maps overloaded (-) operator interface function to
870	! {\tt ESMF\_BaseTime} base class
871	!
872	! The arguments are:
873	! \begin{description}
874	! \item[time]
875	! The given {\tt ESMF\_Time} to decrement
876	! \item[timeinterval]
877	! The {\tt ESMF\_TimeInterval} to subtract from the given
878	! {\tt ESMF\_Time}
879	! \end{description}
880	!
881	! !REQUIREMENTS:
882	! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
883	!EOP
884
885	! copy ESMF_Time specific properties (e.g. calendar, timezone)
886	ESMF_TimeDec = time
887
888	! call ESMC_BaseTime base class function
889	call c_ESMC_BaseTimeDec(time, timeinterval, ESMF_TimeDec)
890
891	end function ESMF_TimeDec
892
893	!
894	! this is added for certain compilers that don't deal with commutativity
895	!
896	function ESMF_TimeDec2(timeinterval, time)
897	type(ESMF_Time) :: ESMF_TimeDec2
898	type(ESMF_Time), intent(in) :: time
899	type(ESMF_TimeInterval), intent(in) :: timeinterval
900	ESMF_TimeDec2 = ESMF_TimeDec( time, timeinterval )
901	end function ESMF_TimeDec2
902	!
903	!------------------------------------------------------------------------------
904	!BOP
905	! !IROUTINE: ESMF_TimeDiff - Return the difference between two time instants
906	!
907	! !INTERFACE:
908	function ESMF_TimeDiff(time1, time2)
909	!
910	! !RETURN VALUE:
911	type(ESMF_TimeInterval) :: ESMF_TimeDiff
912	!
913	! !ARGUMENTS:
914	type(ESMF_Time), intent(in) :: time1
915	type(ESMF_Time), intent(in) :: time2
916	! !LOCAL:
917	integer :: rc
918
919	! !DESCRIPTION:
920	! Return the {\tt ESMF\_TimeInterval} difference between two
921	! {\tt ESMF\_Time} instants
922	!
923	! Maps overloaded (-) operator interface function to
924	! {\tt ESMF\_BaseTime} base class
925	!
926	! The arguments are:
927	! \begin{description}
928	! \item[time1]
929	! The first {\tt ESMF\_Time} instant
930	! \item[time2]
931	! The second {\tt ESMF\_Time} instant
932	! \end{description}
933	!
934	! !REQUIREMENTS:
935	! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2
936	!EOP
937
938	! call ESMC_BaseTime base class function
939	CALL ESMF_TimeIntervalSet( ESMF_TimeDiff, rc=rc )
940	call c_ESMC_BaseTimeDiff(time1, time2, ESMF_TimeDiff)
941
942	end function ESMF_TimeDiff
943
944	!------------------------------------------------------------------------------
945	!BOP
946	! !IROUTINE: ESMF_TimeEQ - Compare two times for equality
947	!
948	! !INTERFACE:
949	function ESMF_TimeEQ(time1, time2)
950	!
951	! !RETURN VALUE:
952	logical :: ESMF_TimeEQ
953	!
954	! !ARGUMENTS:
955	type(ESMF_Time), intent(in) :: time1
956	type(ESMF_Time), intent(in) :: time2
957	!
958	! !DESCRIPTION:
959	! Return true if both given {\tt ESMF\_Time} instants are equal, false
960	! otherwise. Maps overloaded (==) operator interface function to
961	! {\tt ESMF\_BaseTime} base class.
962	!
963	! The arguments are:
964	! \begin{description}
965	! \item[time1]
966	! First time instant to compare
967	! \item[time2]
968	! Second time instant to compare
969	! \end{description}
970	!
971	! !REQUIREMENTS:
972	! TMG1.5.3, TMG2.4.3, TMG7.2
973	!EOP
974
975	! invoke C to C++ entry point for ESMF_BaseTime base class function
976	call c_ESMC_BaseTimeEQ(time1, time2, ESMF_TimeEQ)
977
978	end function ESMF_TimeEQ
979
980	!------------------------------------------------------------------------------
981	!BOP
982	! !IROUTINE: ESMF_TimeNE - Compare two times for non-equality
983	!
984	! !INTERFACE:
985	function ESMF_TimeNE(time1, time2)
986	!
987	! !RETURN VALUE:
988	logical :: ESMF_TimeNE
989	!
990	! !ARGUMENTS:
991	type(ESMF_Time), intent(in) :: time1
992	type(ESMF_Time), intent(in) :: time2
993
994	! !DESCRIPTION:
995	! Return true if both given {\tt ESMF\_Time} instants are not equal, false
996	! otherwise. Maps overloaded (/=) operator interface function to
997	! {\tt ESMF\_BaseTime} base class.
998	!
999	! The arguments are:
1000	! \begin{description}
1001	! \item[time1]
1002	! First time instant to compare
1003	! \item[time2]
1004	! Second time instant to compare
1005	! \end{description}
1006	!
1007	! !REQUIREMENTS:
1008	! TMG1.5.3, TMG2.4.3, TMG7.2
1009	!EOP
1010
1011	! call ESMC_BaseTime base class function
1012	call c_ESMC_BaseTimeNE(time1, time2, ESMF_TimeNE)
1013
1014	end function ESMF_TimeNE
1015
1016	!------------------------------------------------------------------------------
1017	!BOP
1018	! !IROUTINE: ESMF_TimeLT - Time instant 1 less than time instant 2 ?
1019	!
1020	! !INTERFACE:
1021	function ESMF_TimeLT(time1, time2)
1022	!
1023	! !RETURN VALUE:
1024	logical :: ESMF_TimeLT
1025	!
1026	! !ARGUMENTS:
1027	type(ESMF_Time), intent(in) :: time1
1028	type(ESMF_Time), intent(in) :: time2
1029	!
1030	! !DESCRIPTION:
1031	! Return true if first {\tt ESMF\_Time} instant is less than second
1032	! {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (<)
1033	! operator interface function to {\tt ESMF\_BaseTime} base class.
1034	!
1035	! The arguments are:
1036	! \begin{description}
1037	! \item[time1]
1038	! First time instant to compare
1039	! \item[time2]
1040	! Second time instant to compare
1041	! \end{description}
1042	!
1043	! !REQUIREMENTS:
1044	! TMG1.5.3, TMG2.4.3, TMG7.2
1045	!EOP
1046
1047	! call ESMC_BaseTime base class function
1048	call c_ESMC_BaseTimeLT(time1, time2, ESMF_TimeLT)
1049
1050	end function ESMF_TimeLT
1051
1052	!------------------------------------------------------------------------------
1053	!BOP
1054	! !IROUTINE: ESMF_TimeGT - Time instant 1 greater than time instant 2 ?
1055	!
1056	! !INTERFACE:
1057	function ESMF_TimeGT(time1, time2)
1058	!
1059	! !RETURN VALUE:
1060	logical :: ESMF_TimeGT
1061	!
1062	! !ARGUMENTS:
1063	type(ESMF_Time), intent(in) :: time1
1064	type(ESMF_Time), intent(in) :: time2
1065	!
1066	! !DESCRIPTION:
1067	! Return true if first {\tt ESMF\_Time} instant is greater than second
1068	! {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (>) operator
1069	! interface function to {\tt ESMF\_BaseTime} base class.
1070	!
1071	! The arguments are:
1072	! \begin{description}
1073	! \item[time1]
1074	! First time instant to compare
1075	! \item[time2]
1076	! Second time instant to compare
1077	! \end{description}
1078	!
1079	! !REQUIREMENTS:
1080	! TMG1.5.3, TMG2.4.3, TMG7.2
1081	!EOP
1082
1083	! call ESMC_BaseTime base class function
1084	call c_ESMC_BaseTimeGT(time1, time2, ESMF_TimeGT)
1085
1086	end function ESMF_TimeGT
1087
1088	!------------------------------------------------------------------------------
1089	!BOP
1090	! !IROUTINE: ESMF_TimeLE - Time instant 1 less than or equal to time instant 2 ?
1091	!
1092	! !INTERFACE:
1093	function ESMF_TimeLE(time1, time2)
1094	!
1095	! !RETURN VALUE:
1096	logical :: ESMF_TimeLE
1097	!
1098	! !ARGUMENTS:
1099	type(ESMF_Time), intent(in) :: time1
1100	type(ESMF_Time), intent(in) :: time2
1101	!
1102	! !DESCRIPTION:
1103	! Return true if first {\tt ESMF\_Time} instant is less than or equal to
1104	! second {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (<=)
1105	! operator interface function to {\tt ESMF\_BaseTime} base class.
1106	!
1107	! The arguments are:
1108	! \begin{description}
1109	! \item[time1]
1110	! First time instant to compare
1111	! \item[time2]
1112	! Second time instant to compare
1113	! \end{description}
1114	!
1115	! !REQUIREMENTS:
1116	! TMG1.5.3, TMG2.4.3, TMG7.2
1117	!EOP
1118
1119	! call ESMC_BaseTime base class function
1120	call c_ESMC_BaseTimeLE(time1, time2, ESMF_TimeLE)
1121
1122	end function ESMF_TimeLE
1123
1124	!------------------------------------------------------------------------------
1125	!BOP
1126	! !IROUTINE: ESMF_TimeGE - Time instant 1 greater than or equal to time instant 2 ?
1127	!
1128	! !INTERFACE:
1129	function ESMF_TimeGE(time1, time2)
1130	!
1131	! !RETURN VALUE:
1132	logical :: ESMF_TimeGE
1133	!
1134	! !ARGUMENTS:
1135	type(ESMF_Time), intent(in) :: time1
1136	type(ESMF_Time), intent(in) :: time2
1137	!
1138	! !DESCRIPTION:
1139	! Return true if first {\tt ESMF\_Time} instant is greater than or equal to
1140	! second {\tt ESMF\_Time} instant, false otherwise. Maps overloaded (>=)
1141	! operator interface function to {\tt ESMF\_BaseTime} base class.
1142	!
1143	! The arguments are:
1144	! \begin{description}
1145	! \item[time1]
1146	! First time instant to compare
1147	! \item[time2]
1148	! Second time instant to compare
1149	! \end{description}
1150	!
1151	! !REQUIREMENTS:
1152	! TMG1.5.3, TMG2.4.3, TMG7.2
1153	!EOP
1154
1155	! call ESMC_BaseTime base class function
1156	call c_ESMC_BaseTimeGE(time1, time2, ESMF_TimeGE)
1157
1158	end function ESMF_TimeGE
1159
1160	!------------------------------------------------------------------------------
1161	!BOP
1162	! !IROUTINE: ESMF_TimeCopy - Copy a time-instance
1163
1164	! !INTERFACE:
1165	subroutine ESMF_TimeCopy(timeout, timein)
1166
1167	! !ARGUMENTS:
1168	type(ESMF_Time), intent(out) :: timeout
1169	type(ESMF_Time), intent(in) :: timein
1170
1171	! !DESCRIPTION:
1172	! Copy a time-instance to a new instance.
1173	!
1174	! \item[{[rc]}]
1175	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
1176	! \end{description}
1177	!
1178	! !REQUIREMENTS:
1179	! TMGn.n.n
1180	!EOP
1181
1182	timeout%basetime = timein%basetime
1183	timeout%YR = timein%YR
1184	timeout%Calendar => timein%Calendar
1185
1186	end subroutine ESMF_TimeCopy
1187
1188	end module ESMF_TimeMod

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

Download in other formats:

Original Format