ESMF_Base.F90
References to this file elsewhere.
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
289 interface 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
295 end interface
296
297 interface 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
303 end interface
304
305 interface assignment (=)
306 module procedure ESMF_dtas
307 module procedure ESMF_ptas
308 end 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
317 function 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)
322 end function
323
324 function 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)
329 end function
330
331 !------------------------------------------------------------------------------
332 ! function to compare two ESMF_DataTypes to see if they're the same or not
333
334 function 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)
339 end function
340
341 function 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)
346 end function
347
348 subroutine ESMF_dtas(intval, dtval)
349 integer, intent(out) :: intval
350 type(ESMF_DataType), intent(in) :: dtval
351
352 intval = dtval%dtype
353 end subroutine
354
355
356 !------------------------------------------------------------------------------
357 ! function to compare two ESMF_Pointers to see if they're the same or not
358
359 function 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)
364 end function
365
366 function 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)
371 end function
372
373 subroutine ESMF_ptas(ptval, intval)
374 type(ESMF_Pointer), intent(out) :: ptval
375 integer, intent(in) :: intval
376
377 ptval%ptr = intval
378 end 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
384 function 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)
389 end function
390
391 function 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)
396 end function
397
398 !------------------------------------------------------------------------------
399 ! function to compare two ESMF_AxisIndex to see if they're the same or not
400
401 function 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
411 end function
412
413 function 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
423 end 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
550 20 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