source: trunk/WRF.COMMON/WRFV3/external/esmf_time_f90/ESMF_Base.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: 31.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! ESMF Base Module
11!
12! (all lines between the !BOP and !EOP markers will be included in the
13! automated document processing.)
14!------------------------------------------------------------------------------
15
16!------------------------------------------------------------------------------
17! module definition
18
19      module ESMF_BaseMod
20 
21!BOP
22! !MODULE: ESMF_BaseMod - Base class for all ESMF classes
23!
24! !DESCRIPTION:
25!
26! The code in this file implements the Base defined type
27!  and functions which operate on all types.  This is an
28!  interface to the actual C++ base class implementation in the ../src dir.
29!
30! See the ESMF Developers Guide document for more details.
31!
32!------------------------------------------------------------------------------
33
34! !USES:
35      implicit none
36!
37! !PRIVATE TYPES:
38      private
39
40!------------------------------------------------------------------------------
41!
42!    Global integer parameters, used frequently
43
44      integer, parameter :: ESMF_SUCCESS = 0, ESMF_FAILURE = -1
45      integer, parameter :: ESMF_MAXSTR = 128
46      integer, parameter :: ESMF_MAXDIM = 7, &
47                            ESMF_MAXDECOMPDIM=3, &
48                            ESMF_MAXGRIDDIM=2
49     
50      integer, parameter :: ESMF_MAJOR_VERSION = 2
51      integer, parameter :: ESMF_MINOR_VERSION = 1
52      integer, parameter :: ESMF_REVISION      = 1
53      integer, parameter :: ESMF_PATCHLEVEL    = 0
54      character(32), parameter :: ESMF_VERSION_STRING = "2.1.1"
55
56!------------------------------------------------------------------------------
57!
58      type ESMF_Status
59      private
60          integer :: status
61      end type
62
63      type(ESMF_Status), parameter :: ESMF_STATE_UNINIT = ESMF_Status(1), &
64                                      ESMF_STATE_READY = ESMF_Status(2), &
65                                      ESMF_STATE_UNALLOCATED = ESMF_Status(3), &
66                                      ESMF_STATE_ALLOCATED = ESMF_Status(4), &
67                                      ESMF_STATE_BUSY = ESMF_Status(5), &
68                                      ESMF_STATE_INVALID = ESMF_Status(6)
69 
70!------------------------------------------------------------------------------
71!
72      type ESMF_Pointer
73      private
74          integer*8 :: ptr
75      end type
76
77      type(ESMF_Pointer), parameter :: ESMF_NULL_POINTER = ESMF_Pointer(0), &
78                                       ESMF_BAD_POINTER = ESMF_Pointer(-1)
79
80
81!------------------------------------------------------------------------------
82!
83      !! TODO: I believe if we define an assignment(=) operator to convert
84      !!   a datatype into integer, then we could use the type and kind as
85      !!   targets in a select case() statement and make the contents private.
86      !!   (see pg 248 of the "big book")
87      type ESMF_DataType
88      !!private
89          integer :: dtype
90      end type
91
92      type(ESMF_DataType), parameter :: ESMF_DATA_INTEGER = ESMF_DataType(1), &
93                                        ESMF_DATA_REAL = ESMF_DataType(2), &
94                                        ESMF_DATA_LOGICAL = ESMF_DataType(3), &
95                                        ESMF_DATA_CHARACTER = ESMF_DataType(4)
96
97!------------------------------------------------------------------------------
98
99      integer, parameter :: &
100                   ESMF_KIND_I1 = selected_int_kind(2), &
101                   ESMF_KIND_I2 = selected_int_kind(4), &
102                   ESMF_KIND_I4 = selected_int_kind(9), &
103                   ESMF_KIND_I8 = selected_int_kind(18), &
104                   ESMF_KIND_R4 = selected_real_kind(3,25), &
105                   ESMF_KIND_R8 = selected_real_kind(6,45), &
106                   ESMF_KIND_C8 = selected_real_kind(3,25), &
107                   ESMF_KIND_C16 = selected_real_kind(6,45)
108
109!------------------------------------------------------------------------------
110
111      type ESMF_DataValue
112      private
113          type(ESMF_DataType) :: dt
114          integer :: rank
115          ! how do you do values of all types here ? TODO
116          ! in C++ i'd do a union w/ overloaded access funcs
117          integer :: vi
118          !integer, dimension (:), pointer :: vip
119          !real :: vr
120          !real, dimension (:), pointer :: vrp
121          !logical :: vl
122          !logical, pointer :: vlp
123          !character (len=ESMF_MAXSTR) :: vc
124          !character, pointer :: vcp
125      end type
126
127!------------------------------------------------------------------------------
128!
129      type ESMF_Attribute
130      private
131          character (len=ESMF_MAXSTR) :: attr_name
132          type (ESMF_DataType) :: attr_type
133          type (ESMF_DataValue) :: attr_value
134      end type
135
136!------------------------------------------------------------------------------
137!
138      !! TODO: this should be a shallow object, with a simple init() and
139      !!  get() function, and the contents should go back to being private.
140      type ESMF_AxisIndex
141!     !!private
142          integer :: l
143          integer :: r
144          integer :: max
145          integer :: decomp
146          integer :: gstart
147      end type
148
149      !! TODO: same comment as above.
150      type ESMF_MemIndex
151!     !!private
152          integer :: l
153          integer :: r
154          integer :: str
155          integer :: num
156      end type
157
158!------------------------------------------------------------------------------
159!
160      type ESMF_BasePointer
161      private
162          integer*8 :: base_ptr
163      end type
164
165      integer :: global_count = 0
166
167!------------------------------------------------------------------------------
168!
169!     ! WARNING: must match corresponding values in ../include/ESMC_Base.h
170      type ESMF_Logical
171      private
172          integer :: value
173      end type
174
175      type(ESMF_Logical), parameter :: ESMF_TF_UNKNOWN  = ESMF_Logical(1), &
176                                       ESMF_TF_TRUE     = ESMF_Logical(2), &
177                                       ESMF_TF_FALSE    = ESMF_Logical(3)
178
179!------------------------------------------------------------------------------
180!
181      type ESMF_Base
182      private
183         integer :: ID
184         integer :: ref_count
185         type (ESMF_Status) :: base_status
186         character (len=ESMF_MAXSTR) :: name
187     end type
188
189! !PUBLIC TYPES:
190
191      public ESMF_STATE_INVALID
192!      public ESMF_STATE_UNINIT, ESMF_STATE_READY, &
193!             ESMF_STATE_UNALLOCATED, ESMF_STATE_ALLOCATED, &
194!             ESMF_STATE_BUSY
195
196      public ESMF_DATA_INTEGER, ESMF_DATA_REAL, &
197             ESMF_DATA_LOGICAL, ESMF_DATA_CHARACTER
198
199      public ESMF_KIND_I1, ESMF_KIND_I2, ESMF_KIND_I4, ESMF_KIND_I8, &
200             ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_C8, ESMF_KIND_C16
201
202      public ESMF_NULL_POINTER, ESMF_BAD_POINTER
203
204
205      public ESMF_FAILURE, ESMF_SUCCESS
206      public ESMF_MAXSTR
207      public ESMF_MAXDIM, ESMF_MAXDECOMPDIM, ESMF_MAXGRIDDIM
208     
209      public ESMF_MAJOR_VERSION, ESMF_MINOR_VERSION, ESMF_REVISION
210      public ESMF_VERSION_STRING
211
212      public ESMF_Status, ESMF_Pointer, ESMF_DataType
213      public ESMF_DataValue, ESMF_Attribute
214!      public ESMF_MemIndex
215!      public ESMF_BasePointer
216      public ESMF_Base
217
218      public ESMF_AxisIndex, ESMF_AxisIndexGet
219!      public ESMF_AxisIndexInit
220      public ESMF_Logical
221!      public ESMF_TF_TRUE, ESMF_TF_FALSE
222
223! !PUBLIC MEMBER FUNCTIONS:
224!
225! !DESCRIPTION:
226!     The following routines apply to any type in the system. 
227!     The attribute routines can be inherited as-is.  The other
228!     routines need to be specialized by the higher level objects.
229!
230!   Base class methods
231!      public ESMF_BaseInit
232   
233!      public ESMF_BaseGetConfig
234!      public ESMF_BaseSetConfig
235
236!      public ESMF_BaseGetInstCount
237
238!      public ESMF_BaseSetID
239!      public ESMF_BaseGetID
240
241!      public ESMF_BaseSetRefCount
242!      public ESMF_BaseGetRefCount
243
244!      public ESMF_BaseSetStatus
245!      public ESMF_BaseGetStatus
246
247!   Virtual methods to be defined by derived classes
248!      public ESMF_Read
249!      public ESMF_Write
250!      public ESMF_Validate
251!      public ESMF_Print
252
253!  Attribute methods
254      public ESMF_AttributeSet
255      public ESMF_AttributeGet
256      public ESMF_AttributeGetCount
257      public ESMF_AttributeGetbyNumber
258      public ESMF_AttributeGetNameList
259      public ESMF_AttributeSetList
260      public ESMF_AttributeGetList
261      public ESMF_AttributeSetObjectList
262      public ESMF_AttributeGetObjectList
263      public ESMF_AttributeCopy
264      public ESMF_AttributeCopyAll
265 
266!  Misc methods
267      public ESMF_SetName
268      public ESMF_GetName
269      public ESMF_SetPointer
270      public ESMF_SetNullPointer
271      public ESMF_GetPointer
272
273!  Print methods for calling by higher level print functions
274!  (they have little formatting other than the actual values)
275      public ESMF_StatusString, ESMF_DataTypeString
276
277!  Overloaded = operator functions
278      public operator(.eq.), operator(.ne.), assignment(=)
279!
280!
281!EOP
282
283!------------------------------------------------------------------------------
284
285! overload .eq. & .ne. with additional derived types so you can compare
286!  them as if they were simple integers.
287 
288
289interface operator (.eq.)
290 module procedure ESMF_sfeq
291 module procedure ESMF_dteq
292 module procedure ESMF_pteq
293 module procedure ESMF_tfeq
294 module procedure ESMF_aieq
295end interface
296
297interface operator (.ne.)
298 module procedure ESMF_sfne
299 module procedure ESMF_dtne
300 module procedure ESMF_ptne
301 module procedure ESMF_tfne
302 module procedure ESMF_aine
303end interface
304
305interface assignment (=)
306 module procedure ESMF_dtas
307 module procedure ESMF_ptas
308end interface
309
310!------------------------------------------------------------------------------
311
312      contains
313
314!------------------------------------------------------------------------------
315! function to compare two ESMF_Status flags to see if they're the same or not
316
317function ESMF_sfeq(sf1, sf2)
318 logical ESMF_sfeq
319 type(ESMF_Status), intent(in) :: sf1, sf2
320
321 ESMF_sfeq = (sf1%status .eq. sf2%status)
322end function
323
324function ESMF_sfne(sf1, sf2)
325 logical ESMF_sfne
326 type(ESMF_Status), intent(in) :: sf1, sf2
327
328 ESMF_sfne = (sf1%status .ne. sf2%status)
329end function
330
331!------------------------------------------------------------------------------
332! function to compare two ESMF_DataTypes to see if they're the same or not
333
334function ESMF_dteq(dt1, dt2)
335 logical ESMF_dteq
336 type(ESMF_DataType), intent(in) :: dt1, dt2
337
338 ESMF_dteq = (dt1%dtype .eq. dt2%dtype)
339end function
340
341function ESMF_dtne(dt1, dt2)
342 logical ESMF_dtne
343 type(ESMF_DataType), intent(in) :: dt1, dt2
344
345 ESMF_dtne = (dt1%dtype .ne. dt2%dtype)
346end function
347
348subroutine ESMF_dtas(intval, dtval)
349 integer, intent(out) :: intval
350 type(ESMF_DataType), intent(in) :: dtval
351
352 intval = dtval%dtype
353end subroutine
354
355
356!------------------------------------------------------------------------------
357! function to compare two ESMF_Pointers to see if they're the same or not
358
359function ESMF_pteq(pt1, pt2)
360 logical ESMF_pteq
361 type(ESMF_Pointer), intent(in) :: pt1, pt2
362
363 ESMF_pteq = (pt1%ptr .eq. pt2%ptr)
364end function
365
366function ESMF_ptne(pt1, pt2)
367 logical ESMF_ptne
368 type(ESMF_Pointer), intent(in) :: pt1, pt2
369
370 ESMF_ptne = (pt1%ptr .ne. pt2%ptr)
371end function
372
373subroutine ESMF_ptas(ptval, intval)
374 type(ESMF_Pointer), intent(out) :: ptval
375 integer, intent(in) :: intval
376
377 ptval%ptr = intval
378end subroutine
379
380!------------------------------------------------------------------------------
381! function to compare two ESMF_Logicals to see if they're the same or not
382! also need assignment to real f90 logical?
383
384function ESMF_tfeq(tf1, tf2)
385 logical ESMF_tfeq
386 type(ESMF_Logical), intent(in) :: tf1, tf2
387
388 ESMF_tfeq = (tf1%value .eq. tf2%value)
389end function
390
391function ESMF_tfne(tf1, tf2)
392 logical ESMF_tfne
393 type(ESMF_Logical), intent(in) :: tf1, tf2
394
395 ESMF_tfne = (tf1%value .ne. tf2%value)
396end function
397
398!------------------------------------------------------------------------------
399! function to compare two ESMF_AxisIndex to see if they're the same or not
400
401function ESMF_aieq(ai1, ai2)
402 logical ESMF_aieq
403 type(ESMF_AxisIndex), intent(in) :: ai1, ai2
404
405 ESMF_aieq = ((ai1%l .eq. ai2%l) .and. &
406              (ai1%r .eq. ai2%r) .and. &
407              (ai1%max .eq. ai2%max) .and. &
408              (ai1%decomp .eq. ai2%decomp) .and. &
409              (ai1%gstart .eq. ai2%gstart))
410
411end function
412
413function ESMF_aine(ai1, ai2)
414 logical ESMF_aine
415 type(ESMF_AxisIndex), intent(in) :: ai1, ai2
416
417 ESMF_aine = ((ai1%l .ne. ai2%l) .or. &
418              (ai1%r .ne. ai2%r) .or. &
419              (ai1%max .ne. ai2%max) .or. &
420              (ai1%decomp .ne. ai2%decomp) .or. &
421              (ai1%gstart .ne. ai2%gstart))
422
423end function
424
425!------------------------------------------------------------------------------
426!------------------------------------------------------------------------------
427!
428! Base methods
429!
430!------------------------------------------------------------------------------
431!------------------------------------------------------------------------------
432!BOP
433! !IROUTINE:  ESMF_BaseInit - initialize a Base object
434!
435! !INTERFACE:
436      subroutine ESMF_BaseInit(base, rc)
437!
438! !ARGUMENTS:
439      type(ESMF_Base) :: base                 
440      integer, intent(out), optional :: rc     
441
442!
443! !DESCRIPTION:
444!     Set initial state on a Base object.
445!
446!     \begin{description}
447!     \item [base]
448!           In the Fortran interface, this must in fact be a {\tt Base}
449!           derived type object.  It is expected that all specialized
450!           derived types will include a {\tt Base} object as the first
451!           entry.
452!     \item [{[rc]}]
453!           Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
454!
455!     \end{description}
456!
457!EOP
458
459      logical :: rcpresent                          ! Return code present   
460
461!     !Initialize return code
462      rcpresent = .FALSE.
463      if(present(rc)) then
464        rcpresent = .TRUE.
465        rc = ESMF_FAILURE
466      endif
467
468      global_count = global_count + 1
469      base%ID = global_count
470      base%ref_count = 1
471      base%base_status = ESMF_STATE_READY
472      base%name = "undefined"
473
474      if (rcpresent) rc = ESMF_SUCCESS
475
476      end subroutine ESMF_BaseInit
477
478!------------------------------------------------------------------------------
479!BOP
480! !IROUTINE:  ESMF_SetName - set the name of this object
481!
482! !INTERFACE:
483      subroutine ESMF_SetName(anytype, name, namespace, rc)
484!
485! !ARGUMENTS:
486      type(ESMF_Base) :: anytype                 
487      character (len = *), intent(in), optional :: name   
488      character (len = *), intent(in), optional :: namespace
489      integer, intent(out), optional :: rc     
490
491!
492! !DESCRIPTION:
493!     Associate a name with any object in the system.
494!
495!     \begin{description}
496!     \item [anytype]
497!           In the Fortran interface, this must in fact be a {\tt Base}
498!           derived type object.  It is expected that all specialized
499!           derived types will include a {\tt Base} object as the first
500!           entry.
501!     \item [[name]]
502!           Object name.  An error will be returned if a duplicate name
503!           is specified.  If a name is not given a unique name will be
504!           generated and can be queried by the {\tt ESMF_GetName} routine.
505!     \item [[namespace]]
506!           Object namespace (e.g. "Application", "Component", "Grid", etc).
507!           If given, the name will be checked that it is unique within
508!           this namespace.  If not given, the generated name will be
509!           unique within this namespace.  If namespace is not specified,
510!           a default "global" namespace will be assumed and the same rules
511!           for names will be followed.
512!     \item [[rc]]
513!           Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
514!
515!     \end{description}
516!
517!
518
519!
520!EOP
521! !REQUIREMENTS:  FLD1.5, FLD1.5.3
522      logical :: rcpresent                          ! Return code present   
523      character (len = ESMF_MAXSTR) :: ournamespace ! Namespace if not given
524      character (len = ESMF_MAXSTR) :: defaultname  ! Name if not given
525      integer, save :: seqnum = 0       ! HACK - generate uniq names
526                                        ! but not coordinated across procs
527
528!     !Initialize return code
529      rcpresent = .FALSE.
530      if(present(rc)) then
531        rcpresent = .TRUE.
532        rc = ESMF_FAILURE
533      endif
534
535!     ! TODO: this code should generate a unique name if a name
536!     !   is not given.  If a namespace is given, the name has to
537!     !   be unique within that namespace.  Example namespaces could
538!     !   be: Applications, Components, Fields/Bundles, Grids.
539!     
540!     ! Construct a default namespace if one is not given
541      if((.not. present(namespace)) .or. (namespace .eq. "")) then
542          ournamespace = "global"
543      else
544          ournamespace = namespace
545      endif
546!     ! Construct a default name if one is not given
547      if((.not. present(name)) .or. (name .eq. "")) then
548
549          write(defaultname, 20) trim(ournamespace), seqnum
55020        format(A,I3.3)
551          seqnum = seqnum + 1
552          anytype%name = defaultname
553      else
554          anytype%name = name
555      endif
556
557      if (rcpresent) rc = ESMF_SUCCESS
558
559      end subroutine ESMF_SetName
560
561!-------------------------------------------------------------------------
562!BOP
563! !IROUTINE:  ESMF_GetName - get the name of this object
564!
565! !INTERFACE:
566      subroutine ESMF_GetName(anytype, name, rc)
567!
568! !ARGUMENTS:
569      type(ESMF_Base), intent(in) :: anytype             ! any ESMF object/type
570      character (len = *), intent(out) :: name           ! object/type name
571      integer, intent(out), optional :: rc               ! return code
572
573!
574! !DESCRIPTION:
575!     Return the name of any type in the system.
576
577!
578!EOP
579! !REQUIREMENTS:  FLD1.5, FLD1.5.3
580
581      name = anytype%name
582      if (present(rc)) rc = ESMF_SUCCESS
583
584      end subroutine ESMF_GetName
585
586
587!-------------------------------------------------------------------------
588!BOP
589! !IROUTINE:  ESMF_AttributeSet - set attribute on an ESMF type
590!
591! !INTERFACE:
592      subroutine ESMF_AttributeSet(anytype, name, value, rc)
593!
594! !ARGUMENTS:
595      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
596      character (len = *), intent(in) :: name            ! attribute name
597      type(ESMF_DataValue), intent(in) :: value              ! attribute value
598      integer, intent(out), optional :: rc               ! return code
599
600!
601! !DESCRIPTION:
602!     Associate a (name,value) pair with any type in the system.
603
604!
605!EOP
606! !REQUIREMENTS:  FLD1.5, FLD1.5.3
607
608      end subroutine ESMF_AttributeSet
609
610
611!-------------------------------------------------------------------------
612!BOP
613! !IROUTINE:  ESMF_AttributeGet - get attribute from an ESMF type
614!
615! !INTERFACE:
616      subroutine ESMF_AttributeGet(anytype, name, type, value, rc)
617!
618! !ARGUMENTS:
619      type(ESMF_Base), intent(in) :: anytype           ! any ESMF type
620      character (len = *), intent(in) :: name          ! attribute name
621      type(ESMF_DataType), intent(out) :: type             ! all possible data types
622      type(ESMF_DataValue), intent(out) :: value           ! attribute value
623      integer, intent(out), optional :: rc             ! return code
624
625!
626! !DESCRIPTION:
627
628!
629!EOP
630! !REQUIREMENTS:  FLD1.5.1, FLD1.5.3
631
632      end subroutine ESMF_AttributeGet
633
634
635!-------------------------------------------------------------------------
636!BOP
637!
638! !IROUTINE:  ESMF_AttributeGetCount - get an ESMF object's number of attributes
639!
640! !INTERFACE:
641      subroutine ESMF_AttributeGetCount(anytype, count, rc)
642!
643! !ARGUMENTS:
644      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
645      integer, intent(out) :: count                      ! attribute count
646      integer, intent(out), optional :: rc               ! return code
647
648!
649! !DESCRIPTION:
650! Returns number of attributes present.
651
652!
653!EOP
654! !REQUIREMENTS:  FLD1.7.5
655
656      end subroutine ESMF_AttributeGetCount
657
658
659!-------------------------------------------------------------------------
660!BOP
661!
662! !IROUTINE:  ESMF_AttributeGetbyNumber - get an ESMF object's attribute by num ber
663!
664! !INTERFACE:
665      subroutine ESMF_AttributeGetbyNumber(anytype, number, name, type, value, rc)
666!
667! !ARGUMENTS:
668      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
669      integer, intent(in) :: number                      ! attribute number
670      character (len = *), intent(in) :: name            ! attribute name
671      type(ESMF_DataType), intent(out) :: type               ! all possible data types
672      type(ESMF_DataValue), intent(out) :: value             ! attribute value
673      integer, intent(out), optional :: rc               ! return code
674
675!
676! !DESCRIPTION:
677! Allows the caller to get attributes by number instead of by name.
678! This can be useful in iterating through all attributes in a loop.
679!
680!EOP
681! !REQUIREMENTS:
682
683      end subroutine ESMF_AttributeGetbyNumber
684
685
686!-------------------------------------------------------------------------
687!BOP
688!
689!IROUTINE:  ESMF_AttributeGetNameList - get an ESMF object's attribute name list
690!
691! !INTERFACE:
692      subroutine ESMF_AttributeGetNameList(anytype, count, namelist, rc)
693!
694! !ARGUMENTS:
695      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
696      integer, intent(out) :: count                      ! attribute count
697      character (len = *), dimension (:), intent(out) :: namelist   ! attribute names
698      integer, intent(out), optional :: rc               ! return code
699
700!
701! !DESCRIPTION:
702! Return a list of all attribute names without returning the values.
703
704!
705!EOP
706! !REQUIREMENTS:  FLD1.7.3
707
708      end subroutine ESMF_AttributeGetNameList
709
710
711!-------------------------------------------------------------------------
712!BOP
713!
714! !IROUTINE:  ESMF_AttributeSetList - set an ESMF object's attributes
715!
716! !INTERFACE:
717      subroutine ESMF_AttributeSetList(anytype, namelist, valuelist, rc)
718
719!
720! !ARGUMENTS:
721      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
722      character (len = *), dimension (:), intent(in) :: namelist    ! attribute names
723      type(ESMF_DataValue), dimension (:), intent(in) :: valuelist      ! attribute values
724      integer, intent(out), optional :: rc               ! return code
725
726!
727! !DESCRIPTION:
728! Set multiple attributes on an object in one call.  Depending on what is
729! allowed by the interface, all attributes may have to have the same type.
730!
731!EOP
732! !REQUIREMENTS:  (none.  added for completeness)
733
734      end subroutine ESMF_AttributeSetList
735
736
737!-------------------------------------------------------------------------
738!BOP
739!
740! !IROUTINE:  ESMF_AttributeGetList - get an ESMF object's attributes
741!
742! !INTERFACE:
743      subroutine ESMF_AttributeGetList(anytype, namelist, typelist, valuelist, rc)
744!
745! !ARGUMENTS:
746      type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
747      character (len = *), dimension (:), intent(in) :: namelist    ! attribute names
748      type(ESMF_DataType), dimension (:), intent(out) :: typelist       ! all possible data types
749      type(ESMF_DataValue), dimension (:), intent(out) :: valuelist     ! attribute values
750      integer, intent(out), optional :: rc               ! return code
751
752!
753! !DESCRIPTION:
754! Get multiple attributes from an object in a single call.
755
756!
757!EOP
758! !REQUIREMENTS:  FLD1.7.4
759
760      end subroutine ESMF_AttributeGetList
761
762
763!-------------------------------------------------------------------------
764!BOP
765!
766! !IROUTINE:  ESMF_AttributeSetObjectList - set an attribute on multiple ESMF objects
767!
768! !INTERFACE:
769      subroutine ESMF_AttributeSetObjectList(anytypelist, name, value, rc)
770!
771! !ARGUMENTS:
772      type(ESMF_Base), dimension (:), intent(in) :: anytypelist     ! list of any ESMF types
773      character (len = *), intent(in) :: name            ! attribute name
774      type(ESMF_DataValue), dimension (:), intent(in) :: value          ! attribute value
775      integer, intent(out), optional :: rc               ! return code
776
777!
778! !DESCRIPTION:
779! Set the same attribute on multiple objects in one call.
780
781!
782!EOP
783! !REQUIREMENTS:  FLD1.5.5 (pri 2)
784
785      end subroutine ESMF_AttributeSetObjectList
786
787
788!-------------------------------------------------------------------------
789!BOP
790!
791!
792! !IROUTINE:  ESMF_AttributeGetObjectList - get an attribute from multiple ESMF objects
793!
794! !INTERFACE:
795      subroutine ESMF_AttributeGetObjectList(anytypelist, name, typelist, valuelist, rc)
796!
797! !ARGUMENTS:
798      type(ESMF_Base), dimension (:), intent(in) :: anytypelist     ! list of any ESMF types
799      character (len = *), intent(in) :: name            ! attribute name
800      type(ESMF_DataType), dimension (:), intent(out) :: typelist       ! all possible data types
801      type(ESMF_DataValue), dimension (:), intent(out) :: valuelist     ! attribute values
802      integer, intent(out), optional :: rc               ! return code
803
804!
805! !DESCRIPTION:
806! Get the same attribute name from multiple objects in one call.
807
808!
809!EOP
810! !REQUIREMENTS:  FLD1.5.5 (pri 2)
811
812      end subroutine ESMF_AttributeGetObjectList
813
814
815!-------------------------------------------------------------------------
816!BOP
817!
818! !IROUTINE:  ESMF_AttributeCopy - copy an attribute between two objects
819!
820! !INTERFACE:
821      subroutine ESMF_AttributeCopy(name, source, destination, rc)
822!
823! !ARGUMENTS:
824      character (len = *), intent(in) :: name            ! attribute name
825      type(ESMF_Base), intent(in) :: source              ! any ESMF type
826      type(ESMF_Base), intent(in) :: destination         ! any ESMF type
827      integer, intent(out), optional :: rc               ! return code
828
829!
830! !DESCRIPTION:
831! The specified attribute associated with the source object is
832! copied to the destination object.  << does this assume overwriting the
833! attribute if it already exists in the output or does this require yet
834! another arg to say what to do with collisions? >>
835
836
837!
838!EOP
839! !REQUIREMENTS:  FLD1.5.4
840
841      end subroutine ESMF_AttributeCopy
842
843
844!-------------------------------------------------------------------------
845!BOP
846!
847!IROUTINE:  ESMC_AttributeCopyAll - copy attributes between two objects
848
849!
850! !INTERFACE:
851      subroutine ESMF_AttributeCopyAll(source, destination, rc)
852!
853! !ARGUMENTS:
854      type(ESMF_Base), intent(in) :: source              ! any ESMF type
855      type(ESMF_Base), intent(in) :: destination         ! any ESMF type
856      integer, intent(out), optional :: rc               ! return code
857
858!
859! !DESCRIPTION:
860! All attributes associated with the source object are copied to the
861! destination object.  Some attributes will have to be considered
862! {\tt read only} and won't be updated by this call.  (e.g. an attribute
863! like {\tt name} must be unique and therefore can't be duplicated.)
864
865!
866!EOP
867! !REQUIREMENTS:  FLD1.5.4
868
869      end subroutine ESMF_AttributeCopyAll
870
871!=========================================================================
872! Misc utility routines, perhaps belongs in a utility file?
873!-------------------------------------------------------------------------
874!BOP
875!
876!IROUTINE:  ESMC_AxisIndexInit - initialize an AxisIndex object
877
878!
879! !INTERFACE:
880      subroutine ESMF_AxisIndexInit(ai, l, r, max, decomp, gstart, rc)
881!
882! !ARGUMENTS:
883      type(ESMF_AxisIndex), intent(inout) :: ai
884      integer, intent(in) :: l, r, max, decomp, gstart
885      integer, intent(out), optional :: rc 
886!
887! !DESCRIPTION:
888!   Set the contents of an AxisIndex type.
889
890!
891!EOP
892! !REQUIREMENTS:
893
894      ai%l = l
895      ai%r = r
896      ai%max = max
897      ai%decomp = decomp
898      ai%gstart = gstart
899
900      if (present(rc)) rc = ESMF_SUCCESS
901
902      end subroutine ESMF_AxisIndexInit
903
904!BOP
905!
906!IROUTINE:  ESMC_AxisIndexInit - initialize an AxisIndex object
907
908!
909! !INTERFACE:
910      subroutine ESMF_AxisIndexGet(ai, l, r, max, decomp, gstart, rc)
911!
912! !ARGUMENTS:
913      type(ESMF_AxisIndex), intent(inout) :: ai
914      integer, intent(out), optional :: l, r, max, decomp, gstart
915      integer, intent(out), optional :: rc 
916!
917! !DESCRIPTION:
918!   Get the contents of an AxisIndex type.
919
920!
921!EOP
922! !REQUIREMENTS:
923
924      if (present(l)) l = ai%l
925      if (present(r)) r = ai%r
926      if (present(max)) max = ai%max
927      if (present(decomp)) decomp = ai%decomp
928      if (present(gstart)) gstart = ai%gstart
929
930      if (present(rc)) rc = ESMF_SUCCESS
931
932      end subroutine ESMF_AxisIndexGet
933
934!-------------------------------------------------------------------------
935!-------------------------------------------------------------------------
936!BOP
937!
938!IROUTINE:  ESMF_SetPointer - set an opaque value
939
940!
941! !INTERFACE:
942      subroutine ESMF_SetPointer(ptype, contents, rc)
943!
944! !ARGUMENTS:
945      type(ESMF_Pointer) :: ptype
946      integer*8, intent(in) :: contents
947      integer, intent(out), optional :: rc 
948
949!
950! !DESCRIPTION:
951!   Set the contents of an opaque pointer type.
952
953!
954!EOP
955! !REQUIREMENTS:
956      ptype%ptr = contents
957      if (present(rc)) rc = ESMF_SUCCESS
958
959      end subroutine ESMF_SetPointer
960
961!-------------------------------------------------------------------------
962!BOP
963!
964!IROUTINE:  ESMF_SetNullPointer - set an opaque value
965
966!
967! !INTERFACE:
968      subroutine ESMF_SetNullPointer(ptype, rc)
969!
970! !ARGUMENTS:
971      type(ESMF_Pointer) :: ptype
972      integer, intent(out), optional :: rc 
973
974!
975! !DESCRIPTION:
976!   Set the contents of an opaque pointer type.
977
978!
979!EOP
980! !REQUIREMENTS:
981      integer*8, parameter :: nullp = 0
982
983      ptype%ptr = nullp
984      if (present(rc)) rc = ESMF_SUCCESS
985
986      end subroutine ESMF_SetNullPointer
987!-------------------------------------------------------------------------
988!BOP
989!  !IROUTINE:  ESMF_GetPointer - get an opaque value
990
991! !INTERFACE:
992      function ESMF_GetPointer(ptype, rc)
993!
994! !RETURN VALUE:
995      integer*8 :: ESMF_GetPointer
996
997! !ARGUMENTS:
998      type(ESMF_Pointer), intent(in) :: ptype
999      integer, intent(out), optional :: rc 
1000
1001!
1002! !DESCRIPTION:
1003!   Get the contents of an opaque pointer type.
1004
1005!
1006!EOP
1007! !REQUIREMENTS:
1008      ESMF_GetPointer = ptype%ptr
1009      if (present(rc)) rc = ESMF_SUCCESS
1010
1011      end function ESMF_GetPointer
1012
1013!-------------------------------------------------------------------------
1014! misc print routines
1015!-------------------------------------------------------------------------
1016!BOP
1017!  !IROUTINE:  ESMF_StatusString - Return status as a string
1018
1019! !INTERFACE:
1020      subroutine ESMF_StatusString(status, string, rc)
1021!
1022! !ARGUMENTS:
1023      type(ESMF_Status), intent(in) :: status
1024      character(len=*), intent(out) :: string
1025      integer, intent(out), optional :: rc 
1026
1027!
1028! !DESCRIPTION:
1029!   Return a status variable as a string.
1030
1031!
1032!EOP
1033! !REQUIREMENTS:
1034
1035      if (status .eq. ESMF_STATE_UNINIT) string = "Uninitialized"
1036      if (status .eq. ESMF_STATE_READY) string = "Ready"
1037      if (status .eq. ESMF_STATE_UNALLOCATED) string = "Unallocated"
1038      if (status .eq. ESMF_STATE_ALLOCATED) string = "Allocated"
1039      if (status .eq. ESMF_STATE_BUSY) string = "Busy"
1040      if (status .eq. ESMF_STATE_INVALID) string = "Invalid"
1041 
1042      if (present(rc)) rc = ESMF_SUCCESS
1043
1044      end subroutine ESMF_StatusString
1045
1046!-------------------------------------------------------------------------
1047!BOP
1048!  !IROUTINE:  ESMF_DataTypeString - Return DataType as a string
1049
1050! !INTERFACE:
1051      subroutine ESMF_DataTypeString(datatype, string, rc)
1052!
1053! !ARGUMENTS:
1054      type(ESMF_DataType), intent(in) :: datatype
1055      character(len=*), intent(out) :: string
1056      integer, intent(out), optional :: rc 
1057
1058!
1059! !DESCRIPTION:
1060!   Return a datatype variable as a string.
1061
1062!
1063!EOP
1064! !REQUIREMENTS:
1065
1066      if (datatype .eq. ESMF_DATA_INTEGER) string = "Integer"
1067      if (datatype .eq. ESMF_DATA_REAL) string = "Real"
1068      if (datatype .eq. ESMF_DATA_LOGICAL) string = "Logical"
1069      if (datatype .eq. ESMF_DATA_CHARACTER) string = "Character"
1070 
1071      if (present(rc)) rc = ESMF_SUCCESS
1072
1073      end subroutine ESMF_DataTypeString
1074
1075!-------------------------------------------------------------------------
1076!
1077!-------------------------------------------------------------------------
1078! put Print and Validate skeletons here - but they should be
1079!  overridden by higher level more specialized functions.
1080!-------------------------------------------------------------------------
1081
1082      end module ESMF_BaseMod
Note: See TracBrowser for help on using the repository browser.