updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / external / esmf_time_f90 / ESMF_Base.F90
blob421e5c61eace7abf4687e4d99719277c78a88e7b
2 ! ESMF Base Module
4 ! (all lines between the !BOP and !EOP markers will be included in the
5 ! automated document processing.)
6 !------------------------------------------------------------------------------
8 !------------------------------------------------------------------------------
9 ! module definition
11       module WRF_ESMF_BaseMod
13 !BOP
14 ! !MODULE: WRF_ESMF_BaseMod - Base class for all ESMF classes
16 ! !DESCRIPTION:
18 ! The code in this file implements the Base defined type
19 !  and functions which operate on all types.  This is an
20 !  interface to the actual C++ base class implementation in the ../src dir.
22 ! See the ESMF Developers Guide document for more details.
24 !------------------------------------------------------------------------------
26 ! !USES:
27       implicit none
29 ! !PRIVATE TYPES:
30       private
32 !------------------------------------------------------------------------------
34 !    Global integer parameters, used frequently
36       integer, parameter :: ESMF_SUCCESS = 0, ESMF_FAILURE = -1
37       integer, parameter :: ESMF_MAXSTR = 128
38       integer, parameter :: ESMF_MAXDIM = 7, &
39                             ESMF_MAXDECOMPDIM=3, &
40                             ESMF_MAXGRIDDIM=2
41      
42       integer, parameter :: ESMF_MAJOR_VERSION = 2
43       integer, parameter :: ESMF_MINOR_VERSION = 1
44       integer, parameter :: ESMF_REVISION      = 1
45       integer, parameter :: ESMF_PATCHLEVEL    = 0
46       character(32), parameter :: ESMF_VERSION_STRING = "2.1.1"
48 !------------------------------------------------------------------------------
50       type ESMF_Status
51       private
52           integer :: status
53       end type
55       type(ESMF_Status), parameter :: ESMF_STATE_UNINIT = ESMF_Status(1), &
56                                       ESMF_STATE_READY = ESMF_Status(2), &
57                                       ESMF_STATE_UNALLOCATED = ESMF_Status(3), &
58                                       ESMF_STATE_ALLOCATED = ESMF_Status(4), &
59                                       ESMF_STATE_BUSY = ESMF_Status(5), &
60                                       ESMF_STATE_INVALID = ESMF_Status(6)
62 !------------------------------------------------------------------------------
64       type ESMF_Pointer
65       private
66           integer*8 :: ptr
67       end type
69       type(ESMF_Pointer), parameter :: ESMF_NULL_POINTER = ESMF_Pointer(0), &
70                                        ESMF_BAD_POINTER = ESMF_Pointer(-1)
73 !------------------------------------------------------------------------------
75       !! TODO: I believe if we define an assignment(=) operator to convert
76       !!   a datatype into integer, then we could use the type and kind as
77       !!   targets in a select case() statement and make the contents private.
78       !!   (see pg 248 of the "big book")
79       type ESMF_DataType
80       !!private
81           integer :: dtype
82       end type
84       type(ESMF_DataType), parameter :: ESMF_DATA_INTEGER = ESMF_DataType(1), &
85                                         ESMF_DATA_REAL = ESMF_DataType(2), &
86                                         ESMF_DATA_LOGICAL = ESMF_DataType(3), &
87                                         ESMF_DATA_CHARACTER = ESMF_DataType(4)
89 !------------------------------------------------------------------------------
91       integer, parameter :: &
92                    ESMF_KIND_I1 = selected_int_kind(2), &
93                    ESMF_KIND_I2 = selected_int_kind(4), &
94                    ESMF_KIND_I4 = selected_int_kind(9), &
95                    ESMF_KIND_I8 = selected_int_kind(14), &
96                    ESMF_KIND_R4 = selected_real_kind(3,25), &
97                    ESMF_KIND_R8 = selected_real_kind(6,45), &
98                    ESMF_KIND_C8 = selected_real_kind(3,25), &
99                    ESMF_KIND_C16 = selected_real_kind(6,45)
101 !------------------------------------------------------------------------------
103       type ESMF_DataValue
104       private
105           type(ESMF_DataType) :: dt
106           integer :: rank
107           ! how do you do values of all types here ? TODO
108           ! in C++ i'd do a union w/ overloaded access funcs
109           integer :: vi
110           !integer, dimension (:), pointer :: vip
111           !real :: vr
112           !real, dimension (:), pointer :: vrp
113           !logical :: vl
114           !logical, pointer :: vlp
115           !character (len=ESMF_MAXSTR) :: vc
116           !character, pointer :: vcp
117       end type
119 !------------------------------------------------------------------------------
121       type ESMF_Attribute
122       private
123           character (len=ESMF_MAXSTR) :: attr_name
124           type (ESMF_DataType) :: attr_type
125           type (ESMF_DataValue) :: attr_value
126       end type
128 !------------------------------------------------------------------------------
130       !! TODO: this should be a shallow object, with a simple init() and
131       !!  get() function, and the contents should go back to being private.
132       type ESMF_AxisIndex
133 !     !!private
134           integer :: l
135           integer :: r
136           integer :: max
137           integer :: decomp
138           integer :: gstart
139       end type
141       !! TODO: same comment as above.
142       type ESMF_MemIndex
143 !     !!private
144           integer :: l
145           integer :: r
146           integer :: str
147           integer :: num
148       end type
150 !------------------------------------------------------------------------------
152       type ESMF_BasePointer
153       private
154           integer*8 :: base_ptr
155       end type
157       integer :: global_count = 0
159 !------------------------------------------------------------------------------
161 !     ! WARNING: must match corresponding values in ../include/ESMC_Base.h
162       type ESMF_Logical
163       private
164           integer :: value
165       end type
167       type(ESMF_Logical), parameter :: ESMF_TF_UNKNOWN  = ESMF_Logical(1), &
168                                        ESMF_TF_TRUE     = ESMF_Logical(2), &
169                                        ESMF_TF_FALSE    = ESMF_Logical(3)
171 !------------------------------------------------------------------------------
173       type ESMF_Base
174       private
175          integer :: ID
176          integer :: ref_count
177          type (ESMF_Status) :: base_status
178          character (len=ESMF_MAXSTR) :: name
179      end type
181 ! !PUBLIC TYPES:
183       public ESMF_STATE_INVALID
184 !      public ESMF_STATE_UNINIT, ESMF_STATE_READY, &
185 !             ESMF_STATE_UNALLOCATED, ESMF_STATE_ALLOCATED, &
186 !             ESMF_STATE_BUSY
188       public ESMF_DATA_INTEGER, ESMF_DATA_REAL, &
189              ESMF_DATA_LOGICAL, ESMF_DATA_CHARACTER
191       public ESMF_KIND_I1, ESMF_KIND_I2, ESMF_KIND_I4, ESMF_KIND_I8, & 
192              ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_C8, ESMF_KIND_C16
194       public ESMF_NULL_POINTER, ESMF_BAD_POINTER
197       public ESMF_FAILURE, ESMF_SUCCESS
198       public ESMF_MAXSTR
199       public ESMF_MAXDIM, ESMF_MAXDECOMPDIM, ESMF_MAXGRIDDIM
200      
201       public ESMF_MAJOR_VERSION, ESMF_MINOR_VERSION, ESMF_REVISION
202       public ESMF_VERSION_STRING 
204       public ESMF_Status, ESMF_Pointer, ESMF_DataType
205       public ESMF_DataValue, ESMF_Attribute
206 !      public ESMF_MemIndex
207 !      public ESMF_BasePointer
208       public ESMF_Base
210       public ESMF_AxisIndex, ESMF_AxisIndexGet
211 !      public ESMF_AxisIndexInit
212       public ESMF_Logical
213 !      public ESMF_TF_TRUE, ESMF_TF_FALSE
215 ! !PUBLIC MEMBER FUNCTIONS:
217 ! !DESCRIPTION:
218 !     The following routines apply to any type in the system.  
219 !     The attribute routines can be inherited as-is.  The other
220 !     routines need to be specialized by the higher level objects.
222 !   Base class methods
223 !      public ESMF_BaseInit
224    
225 !      public ESMF_BaseGetConfig
226 !      public ESMF_BaseSetConfig
228 !      public ESMF_BaseGetInstCount
230 !      public ESMF_BaseSetID
231 !      public ESMF_BaseGetID
233 !      public ESMF_BaseSetRefCount
234 !      public ESMF_BaseGetRefCount
236 !      public ESMF_BaseSetStatus
237 !      public ESMF_BaseGetStatus
239 !   Virtual methods to be defined by derived classes
240 !      public ESMF_Read
241 !      public ESMF_Write
242 !      public ESMF_Validate
243 !      public ESMF_Print
245 !  Attribute methods
246       public ESMF_AttributeSet
247       public ESMF_AttributeGet
248       public ESMF_AttributeGetCount
249       public ESMF_AttributeGetbyNumber
250       public ESMF_AttributeGetNameList
251       public ESMF_AttributeSetList
252       public ESMF_AttributeGetList
253       public ESMF_AttributeSetObjectList
254       public ESMF_AttributeGetObjectList
255       public ESMF_AttributeCopy
256       public ESMF_AttributeCopyAll
258 !  Misc methods
259       public ESMF_SetName
260       public ESMF_GetName
261       public ESMF_SetPointer
262       public ESMF_SetNullPointer
263       public ESMF_GetPointer
265 !  Print methods for calling by higher level print functions
266 !  (they have little formatting other than the actual values)
267       public ESMF_StatusString, ESMF_DataTypeString
269 !  Overloaded = operator functions
270       public operator(.eq.), operator(.ne.), assignment(=)
273 !EOP
275 !------------------------------------------------------------------------------
277 ! overload .eq. & .ne. with additional derived types so you can compare 
278 !  them as if they were simple integers.
281 interface operator (.eq.)
282  module procedure ESMF_sfeq
283  module procedure ESMF_dteq
284  module procedure ESMF_pteq
285  module procedure ESMF_tfeq
286  module procedure ESMF_aieq
287 end interface
289 interface operator (.ne.)
290  module procedure ESMF_sfne
291  module procedure ESMF_dtne
292  module procedure ESMF_ptne
293  module procedure ESMF_tfne
294  module procedure ESMF_aine
295 end interface
297 interface assignment (=)
298  module procedure ESMF_dtas
299  module procedure ESMF_ptas
300 end interface
302 !------------------------------------------------------------------------------
304       contains
306 !------------------------------------------------------------------------------
307 ! function to compare two ESMF_Status flags to see if they're the same or not
309 function ESMF_sfeq(sf1, sf2)
310  logical ESMF_sfeq
311  type(ESMF_Status), intent(in) :: sf1, sf2
313  ESMF_sfeq = (sf1%status .eq. sf2%status)
314 end function
316 function ESMF_sfne(sf1, sf2)
317  logical ESMF_sfne
318  type(ESMF_Status), intent(in) :: sf1, sf2
320  ESMF_sfne = (sf1%status .ne. sf2%status)
321 end function
323 !------------------------------------------------------------------------------
324 ! function to compare two ESMF_DataTypes to see if they're the same or not
326 function ESMF_dteq(dt1, dt2)
327  logical ESMF_dteq
328  type(ESMF_DataType), intent(in) :: dt1, dt2
330  ESMF_dteq = (dt1%dtype .eq. dt2%dtype)
331 end function
333 function ESMF_dtne(dt1, dt2)
334  logical ESMF_dtne
335  type(ESMF_DataType), intent(in) :: dt1, dt2
337  ESMF_dtne = (dt1%dtype .ne. dt2%dtype)
338 end function
340 subroutine ESMF_dtas(intval, dtval)
341  integer, intent(out) :: intval
342  type(ESMF_DataType), intent(in) :: dtval
344  intval = dtval%dtype
345 end subroutine
348 !------------------------------------------------------------------------------
349 ! function to compare two ESMF_Pointers to see if they're the same or not
351 function ESMF_pteq(pt1, pt2)
352  logical ESMF_pteq
353  type(ESMF_Pointer), intent(in) :: pt1, pt2
355  ESMF_pteq = (pt1%ptr .eq. pt2%ptr)
356 end function
358 function ESMF_ptne(pt1, pt2)
359  logical ESMF_ptne
360  type(ESMF_Pointer), intent(in) :: pt1, pt2
362  ESMF_ptne = (pt1%ptr .ne. pt2%ptr)
363 end function
365 subroutine ESMF_ptas(ptval, intval)
366  type(ESMF_Pointer), intent(out) :: ptval
367  integer, intent(in) :: intval
369  ptval%ptr = intval
370 end subroutine
372 !------------------------------------------------------------------------------
373 ! function to compare two ESMF_Logicals to see if they're the same or not
374 ! also need assignment to real f90 logical?
376 function ESMF_tfeq(tf1, tf2)
377  logical ESMF_tfeq
378  type(ESMF_Logical), intent(in) :: tf1, tf2
380  ESMF_tfeq = (tf1%value .eq. tf2%value)
381 end function
383 function ESMF_tfne(tf1, tf2)
384  logical ESMF_tfne
385  type(ESMF_Logical), intent(in) :: tf1, tf2
387  ESMF_tfne = (tf1%value .ne. tf2%value)
388 end function
390 !------------------------------------------------------------------------------
391 ! function to compare two ESMF_AxisIndex to see if they're the same or not
393 function ESMF_aieq(ai1, ai2)
394  logical ESMF_aieq
395  type(ESMF_AxisIndex), intent(in) :: ai1, ai2
397  ESMF_aieq = ((ai1%l .eq. ai2%l) .and. &
398               (ai1%r .eq. ai2%r) .and. &
399               (ai1%max .eq. ai2%max) .and. &
400               (ai1%decomp .eq. ai2%decomp) .and. &
401               (ai1%gstart .eq. ai2%gstart))
403 end function
405 function ESMF_aine(ai1, ai2)
406  logical ESMF_aine
407  type(ESMF_AxisIndex), intent(in) :: ai1, ai2
409  ESMF_aine = ((ai1%l .ne. ai2%l) .or. &
410               (ai1%r .ne. ai2%r) .or. &
411               (ai1%max .ne. ai2%max) .or. &
412               (ai1%decomp .ne. ai2%decomp) .or. &
413               (ai1%gstart .ne. ai2%gstart))
415 end function
417 !------------------------------------------------------------------------------
418 !------------------------------------------------------------------------------
420 ! Base methods
422 !------------------------------------------------------------------------------
423 !------------------------------------------------------------------------------
424 !BOP
425 ! !IROUTINE:  ESMF_BaseInit - initialize a Base object
427 ! !INTERFACE:
428       subroutine ESMF_BaseInit(base, rc)
430 ! !ARGUMENTS:
431       type(ESMF_Base) :: base                 
432       integer, intent(out), optional :: rc     
435 ! !DESCRIPTION:
436 !     Set initial state on a Base object.
438 !     \begin{description}
439 !     \item [base]
440 !           In the Fortran interface, this must in fact be a {\tt Base}
441 !           derived type object.  It is expected that all specialized 
442 !           derived types will include a {\tt Base} object as the first
443 !           entry.
444 !     \item [{[rc]}]
445 !           Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
447 !     \end{description}
449 !EOP
451       logical :: rcpresent                          ! Return code present   
453 !     !Initialize return code
454       rcpresent = .FALSE.
455       if(present(rc)) then
456         rcpresent = .TRUE.
457         rc = ESMF_FAILURE
458       endif
460       global_count = global_count + 1
461       base%ID = global_count
462       base%ref_count = 1
463       base%base_status = ESMF_STATE_READY
464       base%name = "undefined"
466       if (rcpresent) rc = ESMF_SUCCESS
468       end subroutine ESMF_BaseInit
470 !------------------------------------------------------------------------------
471 !BOP
472 ! !IROUTINE:  ESMF_SetName - set the name of this object
474 ! !INTERFACE:
475       subroutine ESMF_SetName(anytype, name, namespace, rc)
477 ! !ARGUMENTS:
478       type(ESMF_Base) :: anytype                 
479       character (len = *), intent(in), optional :: name   
480       character (len = *), intent(in), optional :: namespace
481       integer, intent(out), optional :: rc     
484 ! !DESCRIPTION:
485 !     Associate a name with any object in the system.
487 !     \begin{description}
488 !     \item [anytype]
489 !           In the Fortran interface, this must in fact be a {\tt Base}
490 !           derived type object.  It is expected that all specialized 
491 !           derived types will include a {\tt Base} object as the first
492 !           entry.
493 !     \item [[name]]
494 !           Object name.  An error will be returned if a duplicate name 
495 !           is specified.  If a name is not given a unique name will be
496 !           generated and can be queried by the {\tt ESMF_GetName} routine.
497 !     \item [[namespace]]
498 !           Object namespace (e.g. "Application", "Component", "Grid", etc).
499 !           If given, the name will be checked that it is unique within
500 !           this namespace.  If not given, the generated name will be 
501 !           unique within this namespace.  If namespace is not specified,
502 !           a default "global" namespace will be assumed and the same rules
503 !           for names will be followed.
504 !     \item [[rc]]
505 !           Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
507 !     \end{description}
512 !EOP
513 ! !REQUIREMENTS:  FLD1.5, FLD1.5.3
514       logical :: rcpresent                          ! Return code present   
515       character (len = ESMF_MAXSTR) :: ournamespace ! Namespace if not given
516       character (len = ESMF_MAXSTR) :: defaultname  ! Name if not given
517       integer, save :: seqnum = 0       ! HACK - generate uniq names
518                                         ! but not coordinated across procs
520 !     !Initialize return code
521       rcpresent = .FALSE.
522       if(present(rc)) then
523         rcpresent = .TRUE.
524         rc = ESMF_FAILURE
525       endif
527 !     ! TODO: this code should generate a unique name if a name
528 !     !   is not given.  If a namespace is given, the name has to
529 !     !   be unique within that namespace.  Example namespaces could
530 !     !   be: Applications, Components, Fields/Bundles, Grids.
531 !      
532 !     ! Construct a default namespace if one is not given
533       if( present(namespace) ) then
534           if( namespace .eq. "" ) then
535               ournamespace = "global"
536           else
537               ournamespace = namespace
538           endif
539       else
540               ournamespace = "global"
541       endif
543 !     ! Construct a default name if one is not given
544       if( present(name) ) then
545          if( name .eq. "" ) then
546             write(defaultname, 20) trim(ournamespace), seqnum
547 20          format(A,I3.3)
548             seqnum = seqnum + 1
549             anytype%name = defaultname
550          else
551             anytype%name = name
552          endif
553       else
554          write(defaultname, 20) trim(ournamespace), seqnum
555          seqnum = seqnum + 1
556          anytype%name = defaultname
557       endif
559       if (rcpresent) rc = ESMF_SUCCESS
561       end subroutine ESMF_SetName
563 !-------------------------------------------------------------------------
564 !BOP
565 ! !IROUTINE:  ESMF_GetName - get the name of this object
567 ! !INTERFACE:
568       subroutine ESMF_GetName(anytype, name, rc)
570 ! !ARGUMENTS:
571       type(ESMF_Base), intent(in) :: anytype             ! any ESMF object/type
572       character (len = *), intent(out) :: name           ! object/type name
573       integer, intent(out), optional :: rc               ! return code
576 ! !DESCRIPTION:
577 !     Return the name of any type in the system.
580 !EOP
581 ! !REQUIREMENTS:  FLD1.5, FLD1.5.3
583       name = anytype%name
584       if (present(rc)) rc = ESMF_SUCCESS
586       end subroutine ESMF_GetName
589 !-------------------------------------------------------------------------
590 !BOP
591 ! !IROUTINE:  ESMF_AttributeSet - set attribute on an ESMF type
593 ! !INTERFACE:
594       subroutine ESMF_AttributeSet(anytype, name, value, rc)
596 ! !ARGUMENTS:
597       type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
598       character (len = *), intent(in) :: name            ! attribute name
599       type(ESMF_DataValue), intent(in) :: value              ! attribute value
600       integer, intent(out), optional :: rc               ! return code
603 ! !DESCRIPTION:
604 !     Associate a (name,value) pair with any type in the system.
607 !EOP
608 ! !REQUIREMENTS:  FLD1.5, FLD1.5.3
610       end subroutine ESMF_AttributeSet
613 !-------------------------------------------------------------------------
614 !BOP
615 ! !IROUTINE:  ESMF_AttributeGet - get attribute from an ESMF type
617 ! !INTERFACE:
618       subroutine ESMF_AttributeGet(anytype, name, type, value, rc)
620 ! !ARGUMENTS:
621       type(ESMF_Base), intent(in) :: anytype           ! any ESMF type
622       character (len = *), intent(in) :: name          ! attribute name
623       type(ESMF_DataType), intent(out) :: type             ! all possible data types
624       type(ESMF_DataValue), intent(out) :: value           ! attribute value
625       integer, intent(out), optional :: rc             ! return code
628 ! !DESCRIPTION:
631 !EOP
632 ! !REQUIREMENTS:  FLD1.5.1, FLD1.5.3
634       end subroutine ESMF_AttributeGet
637 !-------------------------------------------------------------------------
638 !BOP
640 ! !IROUTINE:  ESMF_AttributeGetCount - get an ESMF object's number of attributes
642 ! !INTERFACE:
643       subroutine ESMF_AttributeGetCount(anytype, count, rc)
645 ! !ARGUMENTS:
646       type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
647       integer, intent(out) :: count                      ! attribute count
648       integer, intent(out), optional :: rc               ! return code
651 ! !DESCRIPTION:
652 ! Returns number of attributes present.
655 !EOP
656 ! !REQUIREMENTS:  FLD1.7.5
658       end subroutine ESMF_AttributeGetCount
661 !-------------------------------------------------------------------------
662 !BOP
664 ! !IROUTINE:  ESMF_AttributeGetbyNumber - get an ESMF object's attribute by num ber
666 ! !INTERFACE:
667       subroutine ESMF_AttributeGetbyNumber(anytype, number, name, type, value, rc)
669 ! !ARGUMENTS:
670       type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
671       integer, intent(in) :: number                      ! attribute number
672       character (len = *), intent(in) :: name            ! attribute name
673       type(ESMF_DataType), intent(out) :: type               ! all possible data types
674       type(ESMF_DataValue), intent(out) :: value             ! attribute value
675       integer, intent(out), optional :: rc               ! return code
678 ! !DESCRIPTION:
679 ! Allows the caller to get attributes by number instead of by name.
680 ! This can be useful in iterating through all attributes in a loop.
682 !EOP
683 ! !REQUIREMENTS: 
685       end subroutine ESMF_AttributeGetbyNumber
688 !-------------------------------------------------------------------------
689 !BOP
691 !IROUTINE:  ESMF_AttributeGetNameList - get an ESMF object's attribute name list
693 ! !INTERFACE:
694       subroutine ESMF_AttributeGetNameList(anytype, count, namelist, rc)
696 ! !ARGUMENTS:
697       type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
698       integer, intent(out) :: count                      ! attribute count
699       character (len = *), dimension (:), intent(out) :: namelist   ! attribute names
700       integer, intent(out), optional :: rc               ! return code
703 ! !DESCRIPTION:
704 ! Return a list of all attribute names without returning the values.
707 !EOP
708 ! !REQUIREMENTS:  FLD1.7.3
710       end subroutine ESMF_AttributeGetNameList
713 !-------------------------------------------------------------------------
714 !BOP
716 ! !IROUTINE:  ESMF_AttributeSetList - set an ESMF object's attributes 
718 ! !INTERFACE:
719       subroutine ESMF_AttributeSetList(anytype, namelist, valuelist, rc)
722 ! !ARGUMENTS:
723       type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
724       character (len = *), dimension (:), intent(in) :: namelist    ! attribute names
725       type(ESMF_DataValue), dimension (:), intent(in) :: valuelist      ! attribute values
726       integer, intent(out), optional :: rc               ! return code
729 ! !DESCRIPTION:
730 ! Set multiple attributes on an object in one call.  Depending on what is
731 ! allowed by the interface, all attributes may have to have the same type.
733 !EOP
734 ! !REQUIREMENTS:  (none.  added for completeness)
736       end subroutine ESMF_AttributeSetList
739 !-------------------------------------------------------------------------
740 !BOP
742 ! !IROUTINE:  ESMF_AttributeGetList - get an ESMF object's attributes
744 ! !INTERFACE:
745       subroutine ESMF_AttributeGetList(anytype, namelist, typelist, valuelist, rc)
747 ! !ARGUMENTS:
748       type(ESMF_Base), intent(in) :: anytype             ! any ESMF type
749       character (len = *), dimension (:), intent(in) :: namelist    ! attribute names
750       type(ESMF_DataType), dimension (:), intent(out) :: typelist       ! all possible data types
751       type(ESMF_DataValue), dimension (:), intent(out) :: valuelist     ! attribute values
752       integer, intent(out), optional :: rc               ! return code
755 ! !DESCRIPTION:
756 ! Get multiple attributes from an object in a single call.
759 !EOP
760 ! !REQUIREMENTS:  FLD1.7.4
762       end subroutine ESMF_AttributeGetList
765 !-------------------------------------------------------------------------
766 !BOP
768 ! !IROUTINE:  ESMF_AttributeSetObjectList - set an attribute on multiple ESMF objects 
770 ! !INTERFACE:
771       subroutine ESMF_AttributeSetObjectList(anytypelist, name, value, rc)
773 ! !ARGUMENTS:
774       type(ESMF_Base), dimension (:), intent(in) :: anytypelist     ! list of any ESMF types
775       character (len = *), intent(in) :: name            ! attribute name
776       type(ESMF_DataValue), dimension (:), intent(in) :: value          ! attribute value
777       integer, intent(out), optional :: rc               ! return code
780 ! !DESCRIPTION:
781 ! Set the same attribute on multiple objects in one call.
784 !EOP
785 ! !REQUIREMENTS:  FLD1.5.5 (pri 2)
787       end subroutine ESMF_AttributeSetObjectList
790 !-------------------------------------------------------------------------
791 !BOP
794 ! !IROUTINE:  ESMF_AttributeGetObjectList - get an attribute from multiple ESMF objects 
796 ! !INTERFACE:
797       subroutine ESMF_AttributeGetObjectList(anytypelist, name, typelist, valuelist, rc)
799 ! !ARGUMENTS:
800       type(ESMF_Base), dimension (:), intent(in) :: anytypelist     ! list of any ESMF types
801       character (len = *), intent(in) :: name            ! attribute name
802       type(ESMF_DataType), dimension (:), intent(out) :: typelist       ! all possible data types
803       type(ESMF_DataValue), dimension (:), intent(out) :: valuelist     ! attribute values
804       integer, intent(out), optional :: rc               ! return code
807 ! !DESCRIPTION:
808 ! Get the same attribute name from multiple objects in one call.
811 !EOP
812 ! !REQUIREMENTS:  FLD1.5.5 (pri 2)
814       end subroutine ESMF_AttributeGetObjectList
817 !-------------------------------------------------------------------------
818 !BOP
820 ! !IROUTINE:  ESMF_AttributeCopy - copy an attribute between two objects
822 ! !INTERFACE:
823       subroutine ESMF_AttributeCopy(name, source, destination, rc)
825 ! !ARGUMENTS:
826       character (len = *), intent(in) :: name            ! attribute name
827       type(ESMF_Base), intent(in) :: source              ! any ESMF type
828       type(ESMF_Base), intent(in) :: destination         ! any ESMF type
829       integer, intent(out), optional :: rc               ! return code
832 ! !DESCRIPTION:
833 ! The specified attribute associated with the source object is
834 ! copied to the destination object.  << does this assume overwriting the
835 ! attribute if it already exists in the output or does this require yet
836 ! another arg to say what to do with collisions? >>
840 !EOP
841 ! !REQUIREMENTS:  FLD1.5.4
843       end subroutine ESMF_AttributeCopy
846 !-------------------------------------------------------------------------
847 !BOP
849 !IROUTINE:  ESMC_AttributeCopyAll - copy attributes between two objects
852 ! !INTERFACE:
853       subroutine ESMF_AttributeCopyAll(source, destination, rc)
855 ! !ARGUMENTS:
856       type(ESMF_Base), intent(in) :: source              ! any ESMF type
857       type(ESMF_Base), intent(in) :: destination         ! any ESMF type
858       integer, intent(out), optional :: rc               ! return code
861 ! !DESCRIPTION:
862 ! All attributes associated with the source object are copied to the
863 ! destination object.  Some attributes will have to be considered
864 ! {\tt read only} and won't be updated by this call.  (e.g. an attribute
865 ! like {\tt name} must be unique and therefore can't be duplicated.)
868 !EOP
869 ! !REQUIREMENTS:  FLD1.5.4
871       end subroutine ESMF_AttributeCopyAll
873 !=========================================================================
874 ! Misc utility routines, perhaps belongs in a utility file?
875 !-------------------------------------------------------------------------
876 !BOP
878 !IROUTINE:  ESMC_AxisIndexInit - initialize an AxisIndex object
881 ! !INTERFACE:
882       subroutine ESMF_AxisIndexInit(ai, l, r, max, decomp, gstart, rc)
884 ! !ARGUMENTS:
885       type(ESMF_AxisIndex), intent(inout) :: ai
886       integer, intent(in) :: l, r, max, decomp, gstart
887       integer, intent(out), optional :: rc  
889 ! !DESCRIPTION:
890 !   Set the contents of an AxisIndex type.
893 !EOP
894 ! !REQUIREMENTS:
896       ai%l = l
897       ai%r = r
898       ai%max = max
899       ai%decomp = decomp
900       ai%gstart = gstart
902       if (present(rc)) rc = ESMF_SUCCESS
904       end subroutine ESMF_AxisIndexInit
906 !BOP
908 !IROUTINE:  ESMC_AxisIndexInit - initialize an AxisIndex object
911 ! !INTERFACE:
912       subroutine ESMF_AxisIndexGet(ai, l, r, max, decomp, gstart, rc)
914 ! !ARGUMENTS:
915       type(ESMF_AxisIndex), intent(inout) :: ai
916       integer, intent(out), optional :: l, r, max, decomp, gstart
917       integer, intent(out), optional :: rc  
919 ! !DESCRIPTION:
920 !   Get the contents of an AxisIndex type.
923 !EOP
924 ! !REQUIREMENTS:
926       if (present(l)) l = ai%l
927       if (present(r)) r = ai%r
928       if (present(max)) max = ai%max
929       if (present(decomp)) decomp = ai%decomp
930       if (present(gstart)) gstart = ai%gstart
932       if (present(rc)) rc = ESMF_SUCCESS
934       end subroutine ESMF_AxisIndexGet
936 !-------------------------------------------------------------------------
937 !-------------------------------------------------------------------------
938 !BOP
940 !IROUTINE:  ESMF_SetPointer - set an opaque value
943 ! !INTERFACE:
944       subroutine ESMF_SetPointer(ptype, contents, rc)
946 ! !ARGUMENTS:
947       type(ESMF_Pointer) :: ptype 
948       integer*8, intent(in) :: contents
949       integer, intent(out), optional :: rc  
952 ! !DESCRIPTION:
953 !   Set the contents of an opaque pointer type.
956 !EOP
957 ! !REQUIREMENTS:
958       ptype%ptr = contents
959       if (present(rc)) rc = ESMF_SUCCESS
961       end subroutine ESMF_SetPointer
963 !-------------------------------------------------------------------------
964 !BOP
966 !IROUTINE:  ESMF_SetNullPointer - set an opaque value
969 ! !INTERFACE:
970       subroutine ESMF_SetNullPointer(ptype, rc)
972 ! !ARGUMENTS:
973       type(ESMF_Pointer) :: ptype 
974       integer, intent(out), optional :: rc  
977 ! !DESCRIPTION:
978 !   Set the contents of an opaque pointer type.
981 !EOP
982 ! !REQUIREMENTS:
983       integer*8, parameter :: nullp = 0
985       ptype%ptr = nullp
986       if (present(rc)) rc = ESMF_SUCCESS
988       end subroutine ESMF_SetNullPointer
989 !------------------------------------------------------------------------- 
990 !BOP 
991 !  !IROUTINE:  ESMF_GetPointer - get an opaque value 
992 !  
993 ! !INTERFACE: 
994       function ESMF_GetPointer(ptype, rc) 
996 ! !RETURN VALUE:
997       integer*8 :: ESMF_GetPointer
999 ! !ARGUMENTS:
1000       type(ESMF_Pointer), intent(in) :: ptype 
1001       integer, intent(out), optional :: rc  
1004 ! !DESCRIPTION:
1005 !   Get the contents of an opaque pointer type.
1008 !EOP
1009 ! !REQUIREMENTS:
1010       ESMF_GetPointer = ptype%ptr
1011       if (present(rc)) rc = ESMF_SUCCESS
1013       end function ESMF_GetPointer
1015 !------------------------------------------------------------------------- 
1016 ! misc print routines
1017 !------------------------------------------------------------------------- 
1018 !BOP 
1019 !  !IROUTINE:  ESMF_StatusString - Return status as a string
1020 !  
1021 ! !INTERFACE: 
1022       subroutine ESMF_StatusString(status, string, rc)
1024 ! !ARGUMENTS:
1025       type(ESMF_Status), intent(in) :: status
1026       character(len=*), intent(out) :: string
1027       integer, intent(out), optional :: rc  
1030 ! !DESCRIPTION:
1031 !   Return a status variable as a string.
1034 !EOP
1035 ! !REQUIREMENTS:
1037       if (status .eq. ESMF_STATE_UNINIT) string = "Uninitialized"
1038       if (status .eq. ESMF_STATE_READY) string = "Ready"
1039       if (status .eq. ESMF_STATE_UNALLOCATED) string = "Unallocated"
1040       if (status .eq. ESMF_STATE_ALLOCATED) string = "Allocated"
1041       if (status .eq. ESMF_STATE_BUSY) string = "Busy"
1042       if (status .eq. ESMF_STATE_INVALID) string = "Invalid"
1044       if (present(rc)) rc = ESMF_SUCCESS
1046       end subroutine ESMF_StatusString
1048 !------------------------------------------------------------------------- 
1049 !BOP 
1050 !  !IROUTINE:  ESMF_DataTypeString - Return DataType as a string
1051 !  
1052 ! !INTERFACE: 
1053       subroutine ESMF_DataTypeString(datatype, string, rc)
1055 ! !ARGUMENTS:
1056       type(ESMF_DataType), intent(in) :: datatype
1057       character(len=*), intent(out) :: string
1058       integer, intent(out), optional :: rc  
1061 ! !DESCRIPTION:
1062 !   Return a datatype variable as a string.
1065 !EOP
1066 ! !REQUIREMENTS:
1068       if (datatype .eq. ESMF_DATA_INTEGER) string = "Integer"
1069       if (datatype .eq. ESMF_DATA_REAL) string = "Real"
1070       if (datatype .eq. ESMF_DATA_LOGICAL) string = "Logical"
1071       if (datatype .eq. ESMF_DATA_CHARACTER) string = "Character"
1073       if (present(rc)) rc = ESMF_SUCCESS
1075       end subroutine ESMF_DataTypeString
1077 !-------------------------------------------------------------------------
1079 !-------------------------------------------------------------------------
1080 ! put Print and Validate skeletons here - but they should be
1081 !  overridden by higher level more specialized functions.
1082 !-------------------------------------------------------------------------
1084       end module WRF_ESMF_BaseMod