wrfv2_fire/external/esmf_time_f90/ESMF_Base.F90

   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