Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_esmf_extensions.F90 @ 2759

Last change on this file since 2759 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: 19.7 KB

Line
1
2	! "module_esmf_extensions" is responsible for yet-to-be-implemented ESMF
3	! features used by the io_esmf package. Once ESMF development is complete,
4	! this module may be removed.
5
6	! NOTE for implementation of ESMF_*GetCurrent():
7	!
8	! This implementation uses interfaces that pass Fortran POINTERs around
9	! to avoid forcing use of overloaded assignment operators for shallow
10	! copies. The goal of this approach is to be as insulated as possible
11	! from ESMF object implementations. This avoids having to explicitly
12	! copy-in AND copy-out through the standard component init(), run(),
13	! and final() interfaces just to attach references to ESMF objects to
14	! other objects. The explicit CICO might be required if we
15	! instead attached shallow copies of the objects to other objects!
16	! "Might" means it is not required now because ESMF objects are
17	! implemented as simple pointers. However, Nancy Collins says that
18	! the ESMF core team plans to add more state on the Fortran side of the
19	! ESMF objects, so copy-out will eventually be required. Thus we use
20	! POINTERs to attach references, as in other languages. Why ESMF
21	! component interfaces aren't passing POINTERs to Fortran objects is
22	! not clear (TBH)...
23	!
24
25	MODULE module_esmf_extensions
26
27	USE ESMF_Mod
28
29	IMPLICIT NONE
30
31	PRIVATE
32
33
34	! private data
35
36	! Data for ESMF_*GetCurrent()
37	! These flags are set to .TRUE. iff current objects are valid.
38	LOGICAL, SAVE :: current_clock_valid = .FALSE.
39	TYPE(ESMF_Clock), POINTER :: current_clock
40	LOGICAL, SAVE :: current_importstate_valid = .FALSE.
41	TYPE(ESMF_State), POINTER :: current_importstate
42	LOGICAL, SAVE :: current_exportstate_valid = .FALSE.
43	TYPE(ESMF_State), POINTER :: current_exportstate
44	LOGICAL, SAVE :: current_gridcomp_valid = .FALSE.
45	TYPE(ESMF_GridComp), POINTER :: current_gridcomp
46
47	! Flag for "is-initialized" inquiry
48	! NOTE: esmf_is_initialized is not reset to .FALSE. when ESMF_Finalize is called
49	LOGICAL, SAVE :: esmf_is_initialized = .FALSE.
50
51
52	! public routines
53	! These convenience interfaces have been proposed to the ESMF core team.
54	! "get current" variants
55	PUBLIC ESMF_ClockGetCurrent
56	PUBLIC ESMF_ImportStateGetCurrent
57	PUBLIC ESMF_ExportStateGetCurrent
58	PUBLIC ESMF_GridCompGetCurrent
59	! "is-initialized" inquiry
60	PUBLIC WRFU_IsInitialized
61
62	! extensions to standard ESMF interfaces
63	! these extensions conform to documented plans for ESMF extensions
64	! they should be removed as ESMF implementations are released
65	PUBLIC WRFU_TimeGet
66
67	! public routines to be replaced by ESMF internal implementations
68	! These interfaces will not be public because ESMF will always be able
69	! to call them in the right places without user intervention.
70	! "get current" variants
71	PUBLIC ESMF_ClockSetCurrent
72	PUBLIC ESMF_ImportStateSetCurrent
73	PUBLIC ESMF_ExportStateSetCurrent
74	PUBLIC ESMF_GridCompSetCurrent
75	PUBLIC ESMF_SetCurrent
76	! "is-initialized" inquiry
77	PUBLIC ESMF_SetInitialized
78
79	!!!!!!!!! added 20051012, JM
80	! Need to request that this interface be added...
81	PUBLIC WRFU_TimeIntervalDIVQuot
82
83	! duplicated routines from esmf_time_f90
84	! move these to a common shared location later...
85	PUBLIC fraction_to_string
86
87	! hack for bug in PGI 5.1-x
88	PUBLIC ESMF_TimeLE
89	PUBLIC ESMF_TimeGE
90
91	! convenience function
92	PUBLIC ESMF_TimeIntervalIsPositive
93
94	CONTAINS
95
96
97	! Add "is initialized" behavior to ESMF interface
98	FUNCTION WRFU_IsInitialized()
99	LOGICAL WRFU_IsInitialized
100	WRFU_IsInitialized = esmf_is_initialized
101	END FUNCTION WRFU_IsInitialized
102
103	! Add "is initialized" behavior to ESMF interface
104	! This interface will go away as it will be done inside ESMF_Initialize().
105	SUBROUTINE ESMF_SetInitialized()
106	esmf_is_initialized = .TRUE.
107	END SUBROUTINE ESMF_SetInitialized
108
109
110
111	! -------------------------- ESMF-public method -------------------------------
112	!BOP
113	! !IROUTINE: ESMF_ClockGetCurrent - Get current ESMF_Clock
114	! !INTERFACE:
115	SUBROUTINE ESMF_ClockGetCurrent(clock, rc)
116	! !ARGUMENTS:
117	TYPE(ESMF_Clock), POINTER :: clock
118	INTEGER, INTENT(OUT), OPTIONAL :: rc
119	!
120	! !DESCRIPTION:
121	! Get the {\tt ESMF\_Clock} object of the current execution context.
122	!
123	! The arguments are:
124	! \begin{description}
125	! \item[clock]
126	! Upon return this holds the {\tt ESMF\_Clock} object of the current context.
127	! \item[{[rc]}]
128	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
129	! \end{description}
130	!
131	!EOP
132	! !REQUIREMENTS: SSSn.n, GGGn.n
133	!------------------------------------------------------------------------------
134	! Assume failure until success
135	IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
136	IF ( current_clock_valid ) THEN
137	clock => current_clock
138	IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
139	ENDIF
140	END SUBROUTINE ESMF_ClockGetCurrent
141	!------------------------------------------------------------------------------
142
143
144
145	! -------------------------- ESMF-public method -------------------------------
146	!BOP
147	! !IROUTINE: ESMF_ImportStateGetCurrent - Get current import ESMF_State
148	! !INTERFACE:
149	SUBROUTINE ESMF_ImportStateGetCurrent(importstate, rc)
150	! !ARGUMENTS:
151	TYPE(ESMF_State), POINTER :: importstate
152	INTEGER, INTENT(OUT), OPTIONAL :: rc
153	!
154	! !DESCRIPTION:
155	! Get the import {\tt ESMF\_State} object of the current execution context.
156	!
157	! The arguments are:
158	! \begin{description}
159	! \item[importstate]
160	! Upon return this holds the import {\tt ESMF\_State} object of the current context.
161	! \item[{[rc]}]
162	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
163	! \end{description}
164	!
165	!EOP
166	! !REQUIREMENTS: SSSn.n, GGGn.n
167	!------------------------------------------------------------------------------
168	! Assume failure until success
169	IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
170	IF ( current_importstate_valid ) THEN
171	importstate => current_importstate
172	IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
173	ENDIF
174	END SUBROUTINE ESMF_ImportStateGetCurrent
175	!------------------------------------------------------------------------------
176
177
178
179	! -------------------------- ESMF-public method -------------------------------
180	!BOP
181	! !IROUTINE: ESMF_ExportStateGetCurrent - Get current export ESMF_State
182	! !INTERFACE:
183	SUBROUTINE ESMF_ExportStateGetCurrent(exportstate, rc)
184	! !ARGUMENTS:
185	TYPE(ESMF_State), POINTER :: exportstate
186	INTEGER, INTENT(OUT), OPTIONAL :: rc
187	!
188	! !DESCRIPTION:
189	! Get the export {\tt ESMF\_State} object of the current execution context.
190	!
191	! The arguments are:
192	! \begin{description}
193	! \item[exportstate]
194	! Upon return this holds the export {\tt ESMF\_State} object of the current context.
195	! \item[{[rc]}]
196	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
197	! \end{description}
198	!
199	!EOP
200	! !REQUIREMENTS: SSSn.n, GGGn.n
201	!------------------------------------------------------------------------------
202	! Assume failure until success
203	IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
204	IF ( current_exportstate_valid ) THEN
205	exportstate => current_exportstate
206	IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
207	ENDIF
208	END SUBROUTINE ESMF_ExportStateGetCurrent
209	!------------------------------------------------------------------------------
210
211
212
213	! -------------------------- ESMF-public method -------------------------------
214	!BOP
215	! !IROUTINE: ESMF_GridCompGetCurrent - Get current ESMF_GridComp
216	! !INTERFACE:
217	SUBROUTINE ESMF_GridCompGetCurrent(gridcomp, rc)
218	! !ARGUMENTS:
219	TYPE(ESMF_GridComp), POINTER :: gridcomp
220	INTEGER, INTENT(OUT), OPTIONAL :: rc
221	!
222	! !DESCRIPTION:
223	! Get the {\tt ESMF\_GridComp} object of the current execution context.
224	!
225	! The arguments are:
226	! \begin{description}
227	! \item[gridcomp]
228	! Upon return this holds the {\tt ESMF\_GridComp} object of the current context.
229	! \item[{[rc]}]
230	! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
231	! \end{description}
232	!
233	!EOP
234	! !REQUIREMENTS: SSSn.n, GGGn.n
235	!------------------------------------------------------------------------------
236	! Assume failure until success
237	IF ( PRESENT( rc ) ) rc = ESMF_FAILURE
238	IF ( current_gridcomp_valid ) THEN
239	gridcomp => current_gridcomp
240	IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
241	ENDIF
242	END SUBROUTINE ESMF_GridCompGetCurrent
243	!------------------------------------------------------------------------------
244
245
246
247
248	! Temporary method, to be replaced by ESMF internal implementation
249	! Sets the current ESMF_Clock to clock.
250	SUBROUTINE ESMF_ClockSetCurrent(clock)
251	TYPE(ESMF_Clock), POINTER :: clock
252	current_clock => clock
253	current_clock_valid = .TRUE.
254	END SUBROUTINE ESMF_ClockSetCurrent
255	!------------------------------------------------------------------------------
256
257
258	! Temporary method, to be replaced by ESMF internal implementation
259	! Sets the current import ESMF_State to importstate.
260	SUBROUTINE ESMF_ImportStateSetCurrent(importstate)
261	TYPE(ESMF_State), POINTER :: importstate
262	current_importstate => importstate
263	current_importstate_valid = .TRUE.
264	END SUBROUTINE ESMF_ImportStateSetCurrent
265	!------------------------------------------------------------------------------
266
267
268	! Temporary method, to be replaced by ESMF internal implementation
269	! Sets the current export ESMF_State to exportstate.
270	SUBROUTINE ESMF_ExportStateSetCurrent(exportstate)
271	TYPE(ESMF_State), POINTER :: exportstate
272	current_exportstate => exportstate
273	current_exportstate_valid = .TRUE.
274	END SUBROUTINE ESMF_ExportStateSetCurrent
275	!------------------------------------------------------------------------------
276
277
278	! Temporary method, to be replaced by ESMF internal implementation
279	! Sets the current ESMF_GridComp to gridcomp.
280	SUBROUTINE ESMF_GridCompSetCurrent(gridcomp)
281	TYPE(ESMF_GridComp), POINTER :: gridcomp
282	current_gridcomp => gridcomp
283	current_gridcomp_valid = .TRUE.
284	END SUBROUTINE ESMF_GridCompSetCurrent
285	!------------------------------------------------------------------------------
286
287
288	! Temporary method, to be replaced by ESMF internal implementation
289	! Convenience interface to set everything at once...
290	! This routine sets the current ESMF_GridComp, import and export
291	! ESMF_States, and the current ESMF_Clock.
292	! NOTE: It will be possible to remove this routine once ESMF supports
293	! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
294	! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
295	SUBROUTINE ESMF_SetCurrent( gcomp, importState, exportState, clock )
296	TYPE(ESMF_GridComp), OPTIONAL, POINTER :: gcomp
297	TYPE(ESMF_State), OPTIONAL, POINTER :: importState
298	TYPE(ESMF_State), OPTIONAL, POINTER :: exportState
299	TYPE(ESMF_Clock), OPTIONAL, POINTER :: clock
300	IF ( PRESENT( gcomp ) ) THEN
301	CALL ESMF_GridCompSetCurrent( gcomp )
302	CALL ESMF_ImportStateSetCurrent( importState )
303	CALL ESMF_ExportStateSetCurrent( exportState )
304	CALL ESMF_ClockSetCurrent( clock )
305	ENDIF
306	END SUBROUTINE ESMF_SetCurrent
307	!------------------------------------------------------------------------------
308
309
310
311	! begin hack for bug in PGI 5.1-x
312	function ESMF_TimeLE(time1, time2)
313	logical :: ESMF_TimeLE
314	type(ESMF_Time), intent(in) :: time1
315	type(ESMF_Time), intent(in) :: time2
316	ESMF_TimeLE = (time1.LE.time2)
317	end function ESMF_TimeLE
318	function ESMF_TimeGE(time1, time2)
319	logical :: ESMF_TimeGE
320	type(ESMF_Time), intent(in) :: time1
321	type(ESMF_Time), intent(in) :: time2
322	ESMF_TimeGE = (time1.GE.time2)
323	end function ESMF_TimeGE
324	! end hack for bug in PGI 5.1-x
325
326	! convenience function
327	function ESMF_TimeIntervalIsPositive(timeinterval)
328	logical :: ESMF_TimeIntervalIsPositive
329	type(ESMF_TimeInterval), intent(in) :: timeinterval
330	type(ESMF_TimeInterval) :: zerotimeint
331	integer :: rcint
332	CALL ESMF_TimeIntervalSet ( zerotimeint, rc=rcint )
333	ESMF_TimeIntervalIsPositive = (timeinterval .GT. zerotimeint)
334	end function ESMF_TimeIntervalIsPositive
335
336
337
338
339	! Note: this implementation is largely duplicated from external/esmf_time_f90
340	!!!!!!!!!!!!!!!!!! added jm 20051012
341	! new WRF-specific function, Divide two time intervals and return the whole integer, without remainder
342	function WRFU_TimeIntervalDIVQuot(timeinterval1, timeinterval2)
343
344	! !RETURN VALUE:
345	INTEGER :: WRFU_TimeIntervalDIVQuot
346
347	! !ARGUMENTS:
348	type(ESMF_TimeInterval), intent(in) :: timeinterval1
349	type(ESMF_TimeInterval), intent(in) :: timeinterval2
350
351	! !LOCAL
352	INTEGER :: retval, isgn, rc
353	type(ESMF_TimeInterval) :: zero, i1,i2
354
355	! !DESCRIPTION:
356	! Returns timeinterval1 divided by timeinterval2 as a fraction quotient.
357	!
358	! The arguments are:
359	! \begin{description}
360	! \item[timeinterval1]
361	! The dividend
362	! \item[timeinterval2]
363	! The divisor
364	! \end{description}
365	!
366	! !REQUIREMENTS:
367	! TMG1.5.5
368	!EOP
369	call ESMF_TimeIntervalSet( zero, rc=rc )
370	i1 = timeinterval1
371	i2 = timeinterval2
372	isgn = 1
373	if ( i1 .LT. zero ) then
374	i1 = i1 * (-1)
375	isgn = -isgn
376	endif
377	if ( i2 .LT. zero ) then
378	i2 = i2 * (-1)
379	isgn = -isgn
380	endif
381	! repeated subtraction
382	retval = 0
383	DO WHILE ( i1 .GE. i2 )
384	i1 = i1 - i2
385	retval = retval + 1
386	ENDDO
387	retval = retval * isgn
388
389	WRFU_TimeIntervalDIVQuot = retval
390
391	end function WRFU_TimeIntervalDIVQuot
392	!!!!!!!!!!!!!!!!!!
393
394
395
396	! implementations of extensions to standard ESMF interfaces
397	! these extensions conform to documented plans for ESMF extensions
398	! they should be removed as ESMF implementations are released
399
400	! extend ESMF_TimeGet() to make dayOfYear_r8 work...
401	subroutine WRFU_TimeGet(time, yy, yy_i8, &
402	mm, dd, &
403	d, d_i8, &
404	h, m, &
405	s, s_i8, &
406	ms, us, ns, &
407	d_r8, h_r8, m_r8, s_r8, &
408	ms_r8, us_r8, ns_r8, &
409	sN, sD, &
410	calendar, calendarType, timeZone, &
411	timeString, timeStringISOFrac, &
412	dayOfWeek, midMonth, &
413	dayOfYear, dayOfYear_r8, &
414	dayOfYear_intvl, rc)
415
416	type(ESMF_Time), intent(inout) :: time
417	integer(ESMF_KIND_I4), intent(out), optional :: yy
418	integer(ESMF_KIND_I8), intent(out), optional :: yy_i8
419	integer, intent(out), optional :: mm
420	integer, intent(out), optional :: dd
421	integer(ESMF_KIND_I4), intent(out), optional :: d
422	integer(ESMF_KIND_I8), intent(out), optional :: d_i8
423	integer(ESMF_KIND_I4), intent(out), optional :: h
424	integer(ESMF_KIND_I4), intent(out), optional :: m
425	integer(ESMF_KIND_I4), intent(out), optional :: s
426	integer(ESMF_KIND_I8), intent(out), optional :: s_i8
427	integer(ESMF_KIND_I4), intent(out), optional :: ms
428	integer(ESMF_KIND_I4), intent(out), optional :: us
429	integer(ESMF_KIND_I4), intent(out), optional :: ns
430	real(ESMF_KIND_R8), intent(out), optional :: d_r8 ! not implemented
431	real(ESMF_KIND_R8), intent(out), optional :: h_r8 ! not implemented
432	real(ESMF_KIND_R8), intent(out), optional :: m_r8 ! not implemented
433	real(ESMF_KIND_R8), intent(out), optional :: s_r8 ! not implemented
434	real(ESMF_KIND_R8), intent(out), optional :: ms_r8 ! not implemented
435	real(ESMF_KIND_R8), intent(out), optional :: us_r8 ! not implemented
436	real(ESMF_KIND_R8), intent(out), optional :: ns_r8 ! not implemented
437	integer(ESMF_KIND_I4), intent(out), optional :: sN
438	integer(ESMF_KIND_I4), intent(out), optional :: sD
439	type(ESMF_Calendar), intent(out), optional :: calendar
440	type(ESMF_CalendarType), intent(out), optional :: calendarType
441	integer, intent(out), optional :: timeZone
442	character (len=*), intent(out), optional :: timeString
443	character (len=*), intent(out), optional :: timeStringISOFrac
444	integer, intent(out), optional :: dayOfWeek
445	type(ESMF_Time), intent(out), optional :: midMonth
446	integer(ESMF_KIND_I4), intent(out), optional :: dayOfYear
447	real(ESMF_KIND_R8), intent(out), optional :: dayOfYear_r8 ! NOW implemented
448	type(ESMF_TimeInterval), intent(out), optional :: dayOfYear_intvl
449	integer, intent(out), optional :: rc
450	REAL(ESMF_KIND_R8) :: rsec
451	INTEGER(ESMF_KIND_I4) :: year, seconds, Sn, Sd
452	INTEGER(ESMF_KIND_I8), PARAMETER :: SECONDS_PER_DAY = 86400_ESMF_KIND_I8
453
454	call ESMF_TimeGet(time, yy, yy_i8, &
455	mm, dd, &
456	d, d_i8, &
457	h, m, &
458	s, s_i8, &
459	ms, us, ns, &
460	d_r8, h_r8, m_r8, s_r8, &
461	ms_r8, us_r8, ns_r8, &
462	sN, sD, &
463	calendar, calendarType, timeZone, &
464	timeString, timeStringISOFrac, &
465	dayOfWeek, midMonth, &
466	dayOfYear, dayOfYear_r8, &
467	dayOfYear_intvl, rc)
468	IF ( rc == ESMF_SUCCESS ) THEN
469	IF ( PRESENT( dayOfYear_r8 ) ) THEN
470	! get seconds since start of year and fractional seconds
471	CALL ESMF_TimeGet( time, yy=year, s=seconds, sN=Sn, sD=Sd, rc=rc )
472	IF ( rc == ESMF_SUCCESS ) THEN
473	! 64-bit IEEE 754 has 52-bit mantisssa -- only need 25 bits to hold
474	! number of seconds in a year...
475	rsec = REAL( seconds, ESMF_KIND_R8 )
476	IF ( Sd /= 0 ) THEN
477	rsec = rsec + ( REAL( Sn, ESMF_KIND_R8 ) / REAL( Sd, ESMF_KIND_R8 ) )
478	ENDIF
479	dayOfYear_r8 = rsec / REAL( SECONDS_PER_DAY, ESMF_KIND_R8 )
480	! start at 1
481	dayOfYear_r8 = dayOfYear_r8 + 1.0_ESMF_KIND_R8
482	ENDIF
483	ENDIF
484	ENDIF
485
486	end subroutine WRFU_TimeGet
487
488	!------------------------------------------------------------------------------
489
490
491	! duplicated routines from esmf_time_f90
492	! move these to a common shared location later...
493
494	! Convert fraction to string with leading sign.
495	! If fraction simplifies to a whole number or if
496	! denominator is zero, return empty string.
497	! INTEGER*8 interface.
498	SUBROUTINE fraction_to_stringi8( numerator, denominator, frac_str )
499	INTEGER(ESMF_KIND_I8), INTENT(IN) :: numerator
500	INTEGER(ESMF_KIND_I8), INTENT(IN) :: denominator
501	CHARACTER (LEN=*), INTENT(OUT) :: frac_str
502	IF ( denominator > 0 ) THEN
503	IF ( mod( numerator, denominator ) /= 0 ) THEN
504	IF ( numerator > 0 ) THEN
505	WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(numerator), denominator
506	ELSE ! numerator < 0
507	WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(numerator), denominator
508	ENDIF
509	ELSE ! includes numerator == 0 case
510	frac_str = ''
511	ENDIF
512	ELSE ! no-fraction case
513	frac_str = ''
514	ENDIF
515	END SUBROUTINE fraction_to_stringi8
516
517
518	! Convert fraction to string with leading sign.
519	! If fraction simplifies to a whole number or if
520	! denominator is zero, return empty string.
521	! INTEGER interface.
522	SUBROUTINE fraction_to_string( numerator, denominator, frac_str )
523	INTEGER, INTENT(IN) :: numerator
524	INTEGER, INTENT(IN) :: denominator
525	CHARACTER (LEN=*), INTENT(OUT) :: frac_str
526	! locals
527	INTEGER(ESMF_KIND_I8) :: numerator_i8, denominator_i8
528	numerator_i8 = INT( numerator, ESMF_KIND_I8 )
529	denominator_i8 = INT( denominator, ESMF_KIND_I8 )
530	CALL fraction_to_stringi8( numerator_i8, denominator_i8, frac_str )
531	END SUBROUTINE fraction_to_string
532
533	! end of duplicated routines from esmf_time_f90
534
535
536	END MODULE module_esmf_extensions
537

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

Download in other formats:

Original Format