source: lmdz_wrf/WRFV3/external/io_esmf/module_esmf_extensions.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 20.0 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
25MODULE 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
94CONTAINS
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      type(ESMF_Time),         intent(inout)            :: time
416      integer(ESMF_KIND_I4),   intent(out), optional :: yy
417      integer(ESMF_KIND_I8),   intent(out), optional :: yy_i8
418      integer,                 intent(out), optional :: mm
419      integer,                 intent(out), optional :: dd
420      integer(ESMF_KIND_I4),   intent(out), optional :: d
421      integer(ESMF_KIND_I8),   intent(out), optional :: d_i8
422      integer(ESMF_KIND_I4),   intent(out), optional :: h
423      integer(ESMF_KIND_I4),   intent(out), optional :: m
424      integer(ESMF_KIND_I4),   intent(out), optional :: s
425      integer(ESMF_KIND_I8),   intent(out), optional :: s_i8
426      integer(ESMF_KIND_I4),   intent(out), optional :: ms
427      integer(ESMF_KIND_I4),   intent(out), optional :: us
428      integer(ESMF_KIND_I4),   intent(out), optional :: ns
429      real(ESMF_KIND_R8),      intent(out), optional :: d_r8  ! not implemented
430      real(ESMF_KIND_R8),      intent(out), optional :: h_r8  ! not implemented
431      real(ESMF_KIND_R8),      intent(out), optional :: m_r8  ! not implemented
432      real(ESMF_KIND_R8),      intent(out), optional :: s_r8  ! not implemented
433      real(ESMF_KIND_R8),      intent(out), optional :: ms_r8 ! not implemented
434      real(ESMF_KIND_R8),      intent(out), optional :: us_r8 ! not implemented
435      real(ESMF_KIND_R8),      intent(out), optional :: ns_r8 ! not implemented
436      integer(ESMF_KIND_I4),   intent(out), optional :: sN
437      integer(ESMF_KIND_I4),   intent(out), optional :: sD
438      type(ESMF_Calendar),     intent(out), optional :: calendar
439      type(ESMF_CalendarType), intent(out), optional :: calendarType
440      integer,                 intent(out), optional :: timeZone
441      character (len=*),       intent(out), optional :: timeString
442      character (len=*),       intent(out), optional :: timeStringISOFrac
443      integer,                 intent(out), optional :: dayOfWeek
444      type(ESMF_Time),         intent(out), optional :: midMonth
445      integer(ESMF_KIND_I4),   intent(out), optional :: dayOfYear
446      real(ESMF_KIND_R8),      intent(out), optional :: dayOfYear_r8 ! NOW implemented
447      type(ESMF_TimeInterval), intent(out), optional :: dayOfYear_intvl
448      integer,                 intent(out), optional :: rc
449      REAL(ESMF_KIND_R8) :: rsec
450      INTEGER(ESMF_KIND_I4) :: year, seconds, Sn, Sd
451      INTEGER(ESMF_KIND_I8), PARAMETER :: SECONDS_PER_DAY = 86400_ESMF_KIND_I8
452
453      CALL ESMF_TimeGet(time=time, yy=yy, yy_i8=yy_i8, &
454                                    mm=mm, dd=dd, &
455                                    d=d, d_i8=d_i8, &
456                                    h=h, m=m, &
457                                    s=s, s_i8=s_i8, &
458                                    ms=ms, us=us, ns=ns, &
459                                    d_r8=d_r8, h_r8=h_r8, m_r8=m_r8, s_r8=s_r8, &
460                                    ms_r8=ms_r8, us_r8=us_r8, ns_r8=ns_r8, &
461                                    sN=sN, sD=sD, &
462                                    calendar=calendar, calendarType=calendarType, timeZone=timeZone, &
463                                    timeString=timeString, timeStringISOFrac=timeStringISOFrac, &
464                                    dayOfWeek=dayOfWeek, midMonth=midMonth, &
465                                    dayOfYear=dayOfYear,  dayOfYear_R8=dayOfYear_r8, &
466                                    dayOfYear_intvl=dayOfYear_intvl, rc=rc)
467      IF ( rc == ESMF_SUCCESS ) THEN
468        IF ( PRESENT( dayOfYear_r8 ) ) THEN
469          ! get seconds since start of year and fractional seconds
470          CALL ESMF_TimeGet( time, yy=year, s=seconds, sN=Sn, sD=Sd, rc=rc )
471          IF ( rc == ESMF_SUCCESS ) THEN
472            ! 64-bit IEEE 754 has 52-bit mantisssa -- only need 25 bits to hold
473            ! number of seconds in a year...
474            rsec = REAL( seconds, ESMF_KIND_R8 )
475            IF ( PRESENT( Sd ) ) THEN
476              IF ( Sd /= 0 ) THEN
477                rsec = rsec + ( REAL( Sn, ESMF_KIND_R8 ) / REAL( Sd, ESMF_KIND_R8 ) )
478              ENDIF
479            ENDIF
480            dayOfYear_r8 = rsec / REAL( SECONDS_PER_DAY, ESMF_KIND_R8 )
481            ! start at 1
482            dayOfYear_r8 = dayOfYear_r8 + 1.0_ESMF_KIND_R8
483          ENDIF
484        ENDIF
485      ENDIF
486
487      end subroutine WRFU_TimeGet
488
489!------------------------------------------------------------------------------
490
491
492! duplicated routines from esmf_time_f90
493! move these to a common shared location later... 
494
495! Convert fraction to string with leading sign.
496! If fraction simplifies to a whole number or if
497! denominator is zero, return empty string.
498! INTEGER*8 interface. 
499SUBROUTINE fraction_to_stringi8( numerator, denominator, frac_str )
500  INTEGER(ESMF_KIND_I8), INTENT(IN) :: numerator
501  INTEGER(ESMF_KIND_I8), INTENT(IN) :: denominator
502  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
503  IF ( denominator > 0 ) THEN
504    IF ( mod( numerator, denominator ) /= 0 ) THEN
505      IF ( numerator > 0 ) THEN
506        WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(numerator), denominator
507      ELSE   ! numerator < 0
508        WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(numerator), denominator
509      ENDIF
510    ELSE   ! includes numerator == 0 case
511      frac_str = ''
512    ENDIF
513  ELSE   ! no-fraction case
514    frac_str = ''
515  ENDIF
516END SUBROUTINE fraction_to_stringi8
517
518
519! Convert fraction to string with leading sign.
520! If fraction simplifies to a whole number or if
521! denominator is zero, return empty string.
522! INTEGER interface. 
523SUBROUTINE fraction_to_string( numerator, denominator, frac_str )
524  INTEGER, INTENT(IN) :: numerator
525  INTEGER, INTENT(IN) :: denominator
526  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
527  ! locals
528  INTEGER(ESMF_KIND_I8) :: numerator_i8, denominator_i8
529  numerator_i8 = INT( numerator, ESMF_KIND_I8 )
530  denominator_i8 = INT( denominator, ESMF_KIND_I8 )
531  CALL fraction_to_stringi8( numerator_i8, denominator_i8, frac_str )
532END SUBROUTINE fraction_to_string
533
534! end of duplicated routines from esmf_time_f90
535
536
537END MODULE module_esmf_extensions
538
Note: See TracBrowser for help on using the repository browser.