external/esmf_time_f90/ESMF_Base.F90

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