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 |
---|