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