wrfv2_fire/main/wrf_ESMFMod.F

   1 !WRF:DRIVER_LAYER:MAIN
   2 !
   3
   4 !<DESCRIPTION>
   5 ! ESMF-specific modules for building WRF as an ESMF component.
   6 !
   7 ! This source file is only built when ESMF coupling is used.
   8 !
   9 !</DESCRIPTION>
  10
  11
  12
  13 MODULE module_metadatautils
  14 !<DESCRIPTION>
  15 ! This module defines component-independent "model metadata" utilities
  16 ! used for ESMF coupling.
  17 !</DESCRIPTION>
  18 !TODO:  Upgrade this later to support multiple coupling intervals via Alarms
  19 !TODO:  associated with top-level clock.  Do this by adding TimesAttachedToState()
  20 !TODO:  inquiry function that will test an ESMF_State to see if the times are
  21 !TODO:  present via names defined in this module.  Then call it for every
  22 !TODO:  component and resolve conflicts (somehow) for cases where two components
  23 !TODO:  define conflicting clocks.  Of course, a component is allowed to not attach
  24 !TODO:  times to a state at all, if it can handle any time step.
  25 !
  26 !TODO:  Replace meta-data names with "model metadata" conventions such as CF
  27 !TODO:  (once they exist)
  28 !
  29 !TODO:  Refactor to remove duplication of hard-coded names.
  30 !
  31    USE ESMF_Mod
  32
  33    IMPLICIT NONE
  34
  35    ! everything is private by default
  36    PRIVATE
  37
  38    ! Public interfaces
  39    PUBLIC AttachTimesToState
  40    PUBLIC GetTimesFromStates
  41    PUBLIC AttachDecompToState
  42    PUBLIC GetDecompFromState
  43
  44    ! private stuff
  45    CHARACTER (ESMF_MAXSTR) :: str
  46
  47
  48 CONTAINS
  49
  50
  51    ! Attach time information to state as meta-data.
  52    ! Update later to use some form of meta-data standards/conventions for
  53    ! model "time" meta-data.
  54    SUBROUTINE AttachTimesToState( state, startTime, stopTime, couplingInterval )
  55      TYPE(ESMF_State),        INTENT(INOUT) :: state
  56      TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
  57      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
  58      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
  59      ! locals
  60      INTEGER :: rc
  61      INTEGER :: year, month, day, hour, minute, second
  62      INTEGER(ESMF_KIND_I4) :: timevals(6)   ! big enough to hold the vars listed above
  63      ! start time
  64      CALL ESMF_TimeGet(startTime, yy=year, mm=month, dd=day, &
  65                        h=hour, m=minute, s=second, rc=rc)
  66      IF ( rc /= ESMF_SUCCESS ) THEN
  67        CALL wrf_error_fatal ( 'ESMF_TimeGet(startTime) failed' )
  68      ENDIF
  69      timevals(1) = year
  70      timevals(2) = month
  71      timevals(3) = day
  72      timevals(4) = hour
  73      timevals(5) = minute
  74      timevals(6) = second
  75      CALL ESMF_AttributeSet(state, 'ComponentStartTime', SIZE(timevals), timevals, rc=rc)
  76      IF ( rc /= ESMF_SUCCESS ) THEN
  77        CALL wrf_error_fatal ( 'ESMF_AttributeSet(ComponentStartTime) failed' )
  78      ENDIF
  79      ! stop time
  80      CALL ESMF_TimeGet(stopTime, yy=year, mm=month, dd=day, &
  81                        h=hour, m=minute, s=second, rc=rc)
  82      IF ( rc /= ESMF_SUCCESS ) THEN
  83        CALL wrf_error_fatal ( 'ESMF_TimeGet(stopTime) failed' )
  84      ENDIF
  85      timevals(1) = year
  86      timevals(2) = month
  87      timevals(3) = day
  88      timevals(4) = hour
  89      timevals(5) = minute
  90      timevals(6) = second
  91      CALL ESMF_AttributeSet(state, 'ComponentStopTime', SIZE(timevals), timevals, rc=rc)
  92      IF ( rc /= ESMF_SUCCESS ) THEN
  93        CALL wrf_error_fatal ( 'ESMF_AttributeSet(ComponentStopTime) failed' )
  94      ENDIF
  95      ! coupling time step
  96      CALL ESMF_TimeIntervalGet(couplingInterval, yy=year, mm=month, d=day, &
  97                                h=hour, m=minute, s=second, rc=rc)
  98      IF ( rc /= ESMF_SUCCESS ) THEN
  99        CALL wrf_error_fatal ( 'ESMF_TimeIntervalGet(couplingInterval) failed' )
 100      ENDIF
 101      timevals(1) = year
 102      timevals(2) = month
 103      timevals(3) = day
 104      timevals(4) = hour
 105      timevals(5) = minute
 106      timevals(6) = second
 107      CALL ESMF_AttributeSet(state, 'ComponentCouplingInterval', SIZE(timevals), timevals, rc=rc)
 108      IF ( rc /= ESMF_SUCCESS ) THEN
 109        CALL wrf_error_fatal ( 'ESMF_AttributeSet(ComponentCouplingInterval) failed' )
 110      ENDIF
 111    END SUBROUTINE AttachTimesToState
 112
 113
 114
 115    ! Extract time information attached as meta-data from a single
 116    ! ESMF_State.
 117    ! Update later to use some form of meta-data standards/conventions for
 118    ! model "time" meta-data.
 119    SUBROUTINE GetTimesFromState( state, startTime, stopTime, couplingInterval, rc )
 120      TYPE(ESMF_State),        INTENT(IN   ) :: state
 121      TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
 122      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
 123      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
 124      INTEGER, INTENT(INOUT) :: rc
 125      ! locals
 126      INTEGER :: year, month, day, hour, minute, second
 127      INTEGER(ESMF_KIND_I4) :: timevals(6)   ! big enough to hold the vars listed above
 128      ! start time
 129      CALL ESMF_AttributeGet(state, 'ComponentStartTime', SIZE(timevals), timevals, rc=rc)
 130      IF ( rc /= ESMF_SUCCESS ) THEN
 131        CALL wrf_error_fatal ( 'ESMF_AttributeSet(ComponentStartTime) failed' )
 132        !RETURN
 133      ENDIF
 134      year   = timevals(1)
 135      month  = timevals(2)
 136      day    = timevals(3)
 137      hour   = timevals(4)
 138      minute = timevals(5)
 139      second = timevals(6)
 140 write(0,*) ' year ',year,__LINE__
 141 write(0,*) ' month ',month,__LINE__
 142 write(0,*) ' day ',day,__LINE__
 143 write(0,*) ' hour ',hour,__LINE__
 144 write(0,*) ' minute ',minute,__LINE__
 145 write(0,*) ' second ',second,__LINE__
 146      CALL ESMF_TimeSet(startTime, yy=year, mm=month, dd=day, &
 147                        h=hour, m=minute, s=second, rc=rc)
 148      IF ( rc /= ESMF_SUCCESS ) THEN
 149        CALL wrf_error_fatal ( 'ESMF_TimeSet(startTime) failed' )
 150      ENDIF
 151      ! stop time
 152      CALL ESMF_AttributeGet(state, 'ComponentStopTime', SIZE(timevals), timevals, rc=rc)
 153      IF ( rc /= ESMF_SUCCESS ) THEN
 154        CALL wrf_error_fatal ( 'ESMF_AttributeGet(ComponentStopTime) failed' )
 155      ENDIF
 156      year   = timevals(1)
 157      month  = timevals(2)
 158      day    = timevals(3)
 159      hour   = timevals(4)
 160      minute = timevals(5)
 161      second = timevals(6)
 162 write(0,*) ' year ',year,__LINE__
 163 write(0,*) ' month ',month,__LINE__
 164 write(0,*) ' day ',day,__LINE__
 165 write(0,*) ' hour ',hour,__LINE__
 166 write(0,*) ' minute ',minute,__LINE__
 167 write(0,*) ' second ',second,__LINE__
 168      CALL ESMF_TimeSet(stopTime, yy=year, mm=month, dd=day, &
 169                        h=hour, m=minute, s=second, rc=rc)
 170      IF ( rc /= ESMF_SUCCESS ) THEN
 171        CALL wrf_error_fatal ( 'ESMF_TimeSet(stopTime) failed' )
 172      ENDIF
 173      ! coupling time step
 174      CALL ESMF_AttributeGet(state, 'ComponentCouplingInterval', SIZE(timevals), timevals, rc=rc)
 175      IF ( rc /= ESMF_SUCCESS ) THEN
 176        CALL wrf_error_fatal ( 'ESMF_AttributeGet(ComponentCouplingInterval) failed' )
 177      ENDIF
 178      year   = timevals(1)
 179      month  = timevals(2)
 180      day    = timevals(3)
 181      hour   = timevals(4)
 182      minute = timevals(5)
 183      second = timevals(6)
 184 write(0,*) ' year ',year,__LINE__
 185 write(0,*) ' month ',month,__LINE__
 186 write(0,*) ' day ',day,__LINE__
 187 write(0,*) ' hour ',hour,__LINE__
 188 write(0,*) ' minute ',minute,__LINE__
 189 write(0,*) ' second ',second,__LINE__
 190      CALL ESMF_TimeIntervalSet(couplingInterval, yy=year, mm=month, d=day, &
 191                                h=hour, m=minute, s=second, rc=rc)
 192      IF ( rc /= ESMF_SUCCESS ) THEN
 193        CALL wrf_error_fatal ( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
 194      ENDIF
 195    END SUBROUTINE GetTimesFromState
 196
 197
 198
 199    ! Extract time information attached as meta-data from one or more
 200    ! ESMF_States.  To use this with more than one ESMF_State, put the
 201    ! ESMF_States into a single ESMF_State.  If times differ, an attempt
 202    ! is made to reconcile them.
 203    SUBROUTINE GetTimesFromStates( state, startTime, stopTime, couplingInterval )
 204    USE ESMF_Mod
 205      TYPE(ESMF_State),        INTENT(IN   ) :: state
 206      TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
 207      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
 208      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
 209      ! locals
 210      INTEGER :: rc
 211      INTEGER :: numItems, numStates, i, istate
 212      TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
 213      TYPE(ESMF_State) :: tmpState
 214      CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
 215      TYPE(ESMF_Time),         ALLOCATABLE :: startTimes(:)
 216      TYPE(ESMF_Time),         ALLOCATABLE :: stopTimes(:)
 217      TYPE(ESMF_TimeInterval), ALLOCATABLE :: couplingIntervals(:)
 218
 219 ! Unfortunately, implementing this is unnecessarily difficult due
 220 ! to lack of Iterators for ESMF_State.
 221
 222      ! Since there are no convenient iterators for ESMF_State,
 223      ! write a lot of code...
 224      ! Figure out how many items are in the ESMF_State
 225      CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
 226      IF ( rc /= ESMF_SUCCESS) THEN
 227        CALL wrf_error_fatal ( 'ESMF_StateGet(numItems) failed' )
 228      ENDIF
 229      ! allocate an array to hold the types of all items
 230      ALLOCATE( itemTypes(numItems) )
 231      ! allocate an array to hold the names of all items
 232      ALLOCATE( itemNames(numItems) )
 233      ! get the item types and names
 234      CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
 235                         itemNameList=itemNames, rc=rc)
 236      IF ( rc /= ESMF_SUCCESS) THEN
 237        WRITE(str,*) 'ESMF_StateGet itemTypes failed with rc = ', rc
 238        CALL wrf_error_fatal ( str )
 239      ENDIF
 240      ! count how many items are ESMF_States
 241      numStates = 0
 242      DO i=1,numItems
 243        IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
 244          numStates = numStates + 1
 245        ENDIF
 246      ENDDO
 247      ALLOCATE( startTimes(numStates), stopTimes(numStates), &
 248                couplingIntervals(numStates) )
 249      IF ( numStates > 0) THEN
 250        ! finally, extract nested ESMF_States by name, if there are any
 251        ! (should be able to do this by index at least!)
 252        istate = 0
 253        DO i=1,numItems
 254          IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
 255            CALL ESMF_StateGet( state, itemName=TRIM(itemNames(i)), &
 256                                nestedState=tmpState, rc=rc )
 257            IF ( rc /= ESMF_SUCCESS) THEN
 258              WRITE(str,*) 'ESMF_StateGet(',TRIM(itemNames(i)),') failed'
 259              CALL wrf_error_fatal ( str )
 260            ENDIF
 261            istate = istate + 1
 262            CALL GetTimesFromState( tmpState, startTimes(istate),         &
 263                                              stopTimes(istate),          &
 264                                              couplingIntervals(istate), rc )
 265            IF ( rc /= ESMF_SUCCESS ) THEN
 266              istate = istate - 1
 267            ENDIF
 268          ENDIF
 269        ENDDO
 270        CALL ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
 271                             startTime,  stopTime,  couplingInterval )
 272      ELSE
 273        ! there are no nested ESMF_States so use parent state only
 274        CALL GetTimesFromState( state, startTime, stopTime, &
 275                                couplingInterval , rc )
 276      ENDIF
 277
 278      ! deallocate locals
 279      DEALLOCATE( itemTypes )
 280      DEALLOCATE( itemNames )
 281      DEALLOCATE( startTimes, stopTimes, couplingIntervals )
 282
 283    END SUBROUTINE GetTimesFromStates
 284
 285
 286    ! Reconcile all times and intervals in startTimes, stopTimes, and
 287    ! couplingIntervals and return the results in startTime, stopTime, and
 288    ! couplingInterval.  Abort if reconciliation is not possible.
 289    SUBROUTINE ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
 290                               startTime,  stopTime,  couplingInterval )
 291      TYPE(ESMF_Time),         INTENT(INOUT) :: startTimes(:)
 292      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTimes(:)
 293      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingIntervals(:)
 294      TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
 295      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
 296      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
 297      ! locals
 298      INTEGER :: numTimes, numTimesTmp, i
 299 character*256 buttwhump
 300 integer rc
 301
 302      ! how many sets of time info?
 303      numTimes = SIZE(startTimes)
 304      IF ( numTimes < 2 ) THEN
 305        CALL wrf_error_fatal ( 'SIZE(startTimes) too small' )
 306      ENDIF
 307      numTimesTmp = SIZE(stopTimes)
 308      IF ( numTimes /= numTimesTmp ) THEN
 309        CALL wrf_error_fatal ( 'incorrect SIZE(stopTimes)' )
 310      ENDIF
 311      numTimesTmp = SIZE(couplingIntervals)
 312      IF ( numTimes /= numTimesTmp ) THEN
 313        CALL wrf_error_fatal ( 'incorrect SIZE(couplingIntervals)' )
 314      ENDIF
 315
 316      ! reconcile
 317 !TODO:  For now this is very simple.  Fancy it up later.
 318      DO i = 1, numTimes
 319 call esmf_timeget(starttimes(i),timestring=buttwhump,rc=rc)
 320 write(*,*)__LINE__,'startimes',i,trim(buttwhump)
 321 write(0,*)__LINE__,'startimes',i,trim(buttwhump)
 322 call esmf_timeget(stoptimes(i),timestring=buttwhump,rc=rc)
 323 write(*,*)__LINE__,'stoptimes',i,trim(buttwhump)
 324 write(0,*)__LINE__,'stopimes',i,trim(buttwhump)
 325 call esmf_timeintervalget(couplingintervals(i),timestring=buttwhump,rc=rc)
 326 write(*,*)__LINE__,'coupling intervals',i,trim(buttwhump)
 327 write(0,*)__LINE__,'coupling intervals',i,trim(buttwhump)
 328        IF ( i == 1 ) THEN
 329          startTime = startTimes(i)
 330          stopTime = stopTimes(i)
 331          couplingInterval = couplingIntervals(i)
 332        ELSE
 333          IF ( startTimes(i) /= startTime ) THEN
 334            CALL wrf_error_fatal ( 'ReconcileTimes:  inconsistent startTimes' )
 335          ENDIF
 336          IF ( stopTimes(i) /= stopTime ) THEN
 337            CALL wrf_error_fatal ( 'ReconcileTimes:  inconsistent stopTimes' )
 338          ENDIF
 339          IF ( couplingIntervals(i) /= couplingInterval ) THEN
 340            CALL wrf_error_fatal ( 'ReconcileTimes:  inconsistent couplingIntervals' )
 341          ENDIF
 342        ENDIF
 343
 344      ENDDO
 345
 346    END SUBROUTINE ReconcileTimes
 347
 348
 349
 350    !TODO:  Eliminate this once this information can be derived via other
 351    !TODO:  means.
 352    SUBROUTINE AttachDecompToState( state,                        &
 353                                    ids, ide, jds, jde, kds, kde, &
 354                                    ims, ime, jms, jme, kms, kme, &
 355                                    ips, ipe, jps, jpe, kps, kpe, &
 356                                    domdesc, bdy_mask )
 357      TYPE(ESMF_State), INTENT(INOUT) :: state
 358      INTEGER,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde
 359      INTEGER,          INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
 360      INTEGER,          INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
 361      INTEGER,          INTENT(IN   ) :: domdesc
 362      LOGICAL,          INTENT(IN   ) :: bdy_mask(4)
 363      ! locals
 364      INTEGER :: i, rc
 365      ! big enough to hold the integer values listed above
 366      INTEGER(ESMF_KIND_I4) :: intvals(19)
 367      ! big enough to hold the logical values listed above
 368      TYPE(ESMF_Logical) :: logvals(4)
 369
 370      ! first the logicals
 371      ! Usually, when writing an API for a target language, it is considered
 372      ! good practice to use native types of the target language in the
 373      ! interfaces.
 374      logvals = ESMF_FALSE
 375      DO i = 1, SIZE(bdy_mask)
 376        IF (bdy_mask(i)) THEN
 377          logvals(i) = ESMF_TRUE
 378        ENDIF
 379      ENDDO
 380      CALL ESMF_AttributeSet(state, 'DecompositionLogicals', SIZE(logvals), logvals, rc=rc)
 381      IF ( rc /= ESMF_SUCCESS) THEN
 382        CALL wrf_error_fatal ( 'ESMF_AttributeSet(DecompositionLogicals) failed' )
 383      ENDIF
 384      ! now the integers
 385      intvals(1) = ids
 386      intvals(2) = ide
 387      intvals(3) = jds
 388      intvals(4) = jde
 389      intvals(5) = kds
 390      intvals(6) = kde
 391      intvals(7) = ims
 392      intvals(8) = ime
 393      intvals(9) = jms
 394      intvals(10) = jme
 395      intvals(11) = kms
 396      intvals(12) = kme
 397      intvals(13) = ips
 398      intvals(14) = ipe
 399      intvals(15) = jps
 400      intvals(16) = jpe
 401      intvals(17) = kps
 402      intvals(18) = kpe
 403      intvals(19) = domdesc
 404      CALL ESMF_AttributeSet(state, 'DecompositionIntegers', SIZE(intvals), intvals, rc=rc)
 405      IF ( rc /= ESMF_SUCCESS) THEN
 406        CALL wrf_error_fatal ( 'ESMF_AttributeSet(DecompositionIntegers) failed' )
 407      ENDIF
 408    END SUBROUTINE AttachDecompToState
 409
 410
 411
 412    !TODO:  Eliminate this once this information can be derived via other
 413    !TODO:  means.
 414    SUBROUTINE GetDecompFromState( state,                        &
 415                                   ids, ide, jds, jde, kds, kde, &
 416                                   ims, ime, jms, jme, kms, kme, &
 417                                   ips, ipe, jps, jpe, kps, kpe, &
 418                                   domdesc, bdy_mask )
 419      TYPE(ESMF_State), INTENT(IN   ) :: state
 420      INTEGER,          INTENT(  OUT) :: ids, ide, jds, jde, kds, kde
 421      INTEGER,          INTENT(  OUT) :: ims, ime, jms, jme, kms, kme
 422      INTEGER,          INTENT(  OUT) :: ips, ipe, jps, jpe, kps, kpe
 423      INTEGER,          INTENT(  OUT) :: domdesc
 424      LOGICAL,          INTENT(  OUT) :: bdy_mask(4)
 425      ! locals
 426      INTEGER :: i, rc
 427      ! big enough to hold the integer values listed above
 428      INTEGER(ESMF_KIND_I4) :: intvals(19)
 429      ! big enough to hold the logical values listed above
 430      TYPE(ESMF_Logical) :: logvals(4)
 431
 432      ! first the logicals
 433      CALL ESMF_AttributeGet(state, 'DecompositionLogicals', SIZE(logvals), logvals, rc=rc)
 434      IF ( rc /= ESMF_SUCCESS) THEN
 435        CALL wrf_error_fatal ( 'ESMF_AttributeGet(DecompositionLogicals) failed' )
 436      ENDIF
 437      ! Usually, when writing an API for a target language, it is considered
 438      ! good practice to use native types of the target language in the
 439      ! interfaces.
 440      bdy_mask = .FALSE.
 441      DO i = 1, SIZE(logvals)
 442        IF (logvals(i) == ESMF_TRUE) THEN
 443          bdy_mask(i) = .TRUE.
 444        ENDIF
 445      ENDDO
 446      ! now the integers
 447      CALL ESMF_AttributeGet(state, 'DecompositionIntegers', SIZE(intvals), intvals, rc=rc)
 448      IF ( rc /= ESMF_SUCCESS) THEN
 449        CALL wrf_error_fatal ( 'ESMF_AttributeGet(DecompositionIntegers) failed' )
 450      ENDIF
 451      ids = intvals(1)
 452      ide = intvals(2)
 453      jds = intvals(3)
 454      jde = intvals(4)
 455      kds = intvals(5)
 456      kde = intvals(6)
 457      ims = intvals(7)
 458      ime = intvals(8)
 459      jms = intvals(9)
 460      jme = intvals(10)
 461      kms = intvals(11)
 462      kme = intvals(12)
 463      ips = intvals(13)
 464      ipe = intvals(14)
 465      jps = intvals(15)
 466      jpe = intvals(16)
 467      kps = intvals(17)
 468      kpe = intvals(18)
 469      domdesc = intvals(19)
 470    END SUBROUTINE GetDecompFromState
 471
 472
 473
 474 END MODULE module_metadatautils
 475
 476
 477
 478 MODULE module_wrf_component_top
 479 !<DESCRIPTION>
 480 ! This module defines wrf_component_init1(), wrf_component_init2(),
 481 ! wrf_component_run(), and wrf_component_finalize() routines that are called
 482 ! when WRF is run as an ESMF component.
 483 !</DESCRIPTION>
 484
 485    USE ESMF_Mod
 486    USE module_wrf_top, ONLY : wrf_init, wrf_run, wrf_finalize
 487    USE module_domain, ONLY : head_grid, auxhist4_alarm, auxhist5_alarm, auxhist3_alarm, auxhist1_alarm, &
 488        auxhist2_alarm, auxhist6_alarm, auxhist10_alarm, auxhist11_alarm, auxhist9_alarm, &
 489        auxhist7_alarm, auxhist8_alarm, auxinput11_alarm, auxinput3_alarm, auxinput4_alarm, &
 490        auxinput2_alarm, io_esmf, auxinput1_alarm, auxinput5_alarm, auxinput9_alarm, &
 491        auxinput10_alarm, auxinput8_alarm, auxinput6_alarm, auxinput7_alarm, &
 492        get_ijk_from_grid
 493
 494    USE module_esmf_extensions
 495    USE module_metadatautils, ONLY: AttachTimesToState, AttachDecompToState
 496
 497
 498
 499    IMPLICIT NONE
 500
 501    ! everything is private by default
 502    PRIVATE
 503
 504    ! Public entry points
 505    PUBLIC wrf_component_init1
 506    PUBLIC wrf_component_init2
 507    PUBLIC wrf_component_run
 508    PUBLIC wrf_component_finalize
 509
 510    ! private stuff
 511    CHARACTER (ESMF_MAXSTR) :: str
 512
 513 CONTAINS
 514
 515
 516    SUBROUTINE wrf_component_init1( gcomp, importState, exportState, clock, rc )
 517      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 518      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
 519      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
 520      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 521      INTEGER,                     INTENT(  OUT) :: rc
 522 !<DESCRIPTION>
 523 !     WRF component init routine, phase 1.  Passes relevant coupling
 524 !     information back as metadata on exportState.
 525 !
 526 !     The arguments are:
 527 !       gcomp           Component
 528 !       importState     Importstate
 529 !       exportState     Exportstate
 530 !       clock           External clock
 531 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 532 !                       otherwise ESMF_FAILURE.
 533 !</DESCRIPTION>
 534 !TODO:  Note that much of the decomposition-related meta-data attached to the
 535 !TODO:  exportState are WRF-specific and are only useful if other components
 536 !TODO:  want to re-use the WRF IOAPI with the same decomposition as the WRF
 537 !TODO:  model.  This is true for the simple WRF+CPL+SST test case, but will
 538 !TODO:  not be in general.  Of course other components are free to ignore this
 539 !TODO:  information.
 540
 541      ! Local variables
 542      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 543      TYPE(ESMF_State),    POINTER :: p_importState
 544      TYPE(ESMF_State),    POINTER :: p_exportState
 545      TYPE(ESMF_Clock),    POINTER :: p_clock
 546      ! Time hackery
 547      TYPE(ESMF_Time) :: startTime
 548      TYPE(ESMF_Time) :: stopTime
 549      TYPE(ESMF_TimeInterval) :: couplingInterval
 550      ! decomposition hackery
 551      INTEGER :: ids, ide, jds, jde, kds, kde
 552      INTEGER :: ims, ime, jms, jme, kms, kme
 553      INTEGER :: ips, ipe, jps, jpe, kps, kpe
 554      INTEGER :: domdesc
 555      LOGICAL :: bdy_mask(4)
 556      CHARACTER(LEN=256) :: couplingIntervalString
 557
 558      rc = ESMF_SUCCESS
 559
 560      p_gcomp => gcomp
 561      p_importState => importState
 562      p_exportState => exportState
 563      p_clock => clock
 564      ! NOTE:  It will be possible to remove this call once ESMF supports
 565      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 566      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 567      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 568                            exportState=p_exportState, clock=p_clock )
 569
 570      ! Call WRF "init" routine, which, for a DM_PARALLEL run, will recognize
 571      ! that ESMF has already called MPI_INIT and respond appropriately.
 572      CALL wrf_init( no_init1=.TRUE. )
 573
 574      ! For now, use settings from WRF component intialization to set up
 575      ! top-level clock.  Per suggestion from ESMF Core team, these are passed
 576      ! back as attributes on exportState.
 577      CALL wrf_clockprint( 100, head_grid%domain_clock, &
 578             'DEBUG wrf_component_init1():  head_grid%domain_clock,' )
 579      CALL ESMF_ClockGet(head_grid%domain_clock, startTime=startTime, &
 580                         stopTime=stopTime, rc=rc)
 581      IF ( rc /= ESMF_SUCCESS ) THEN
 582        CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_ClockGet failed' )
 583      ENDIF
 584      CALL wrf_debug( 500, 'DEBUG wrf_component_init1():  before wrf_findCouplingInterval' )
 585      CALL wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
 586      CALL wrf_debug( 500, 'DEBUG wrf_component_init1():  after wrf_findCouplingInterval' )
 587      CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
 588                                 rc=rc )
 589      IF ( rc /= ESMF_SUCCESS ) THEN
 590        CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_TimeIntervalGet failed' )
 591      ENDIF
 592      CALL wrf_debug( 100, 'DEBUG wrf_component_init1():  couplingInterval = '//TRIM(couplingIntervalString) )
 593      CALL AttachTimesToState( exportState, startTime, stopTime, couplingInterval )
 594      CALL wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
 595                              ims, ime, jms, jme, kms, kme, &
 596                              ips, ipe, jps, jpe, kps, kpe, &
 597                              domdesc, bdy_mask )
 598      CALL AttachDecompToState( exportState,                  &
 599                                ids, ide, jds, jde, kds, kde, &
 600                                ims, ime, jms, jme, kms, kme, &
 601                                ips, ipe, jps, jpe, kps, kpe, &
 602                                domdesc, bdy_mask )
 603
 604    END SUBROUTINE wrf_component_init1
 605
 606
 607
 608    SUBROUTINE wrf_component_init2( gcomp, importState, exportState, clock, rc )
 609      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 610      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
 611      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
 612      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 613      INTEGER,                     INTENT(  OUT) :: rc
 614 !<DESCRIPTION>
 615 !     WRF component init routine, phase 2.  Initializes importState and
 616 !     exportState.
 617 !
 618 !     The arguments are:
 619 !       gcomp           Component
 620 !       importState     Importstate
 621 !       exportState     Exportstate
 622 !       clock           External clock
 623 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 624 !                       otherwise ESMF_FAILURE.
 625 !</DESCRIPTION>
 626
 627      ! Local variables
 628      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 629      TYPE(ESMF_State),    POINTER :: p_importState
 630      TYPE(ESMF_State),    POINTER :: p_exportState
 631      TYPE(ESMF_Clock),    POINTER :: p_clock
 632      ! Time hackery
 633      TYPE(ESMF_Time) :: startTime
 634      TYPE(ESMF_Time) :: stopTime
 635      TYPE(ESMF_TimeInterval) :: couplingInterval
 636      ! decomposition hackery
 637      INTEGER :: ids, ide, jds, jde, kds, kde
 638      INTEGER :: ims, ime, jms, jme, kms, kme
 639      INTEGER :: ips, ipe, jps, jpe, kps, kpe
 640      INTEGER :: domdesc
 641      LOGICAL :: bdy_mask(4)
 642      TYPE(ESMF_StateType) :: statetype
 643      INTEGER :: itemCount, i
 644      CHARACTER (ESMF_MAXSTR) :: statename
 645      CHARACTER (ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
 646      TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
 647
 648      CALL wrf_debug ( 100, 'wrf_component_init2():  begin' )
 649      ! check exportState
 650      CALL ESMF_StateGet( exportState, itemCount=itemCount, &
 651                          statetype=statetype, rc=rc )
 652      IF ( rc /= ESMF_SUCCESS ) THEN
 653        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed" )
 654      ENDIF
 655      WRITE (str,*) 'wrf_component_init2: exportState itemCount = ', itemCount
 656      CALL wrf_debug ( 100 , TRIM(str) )
 657      IF ( statetype /= ESMF_STATE_EXPORT ) THEN
 658        CALL wrf_error_fatal("wrf_component_init2:  exportState is not an export state" )
 659      ENDIF
 660      ! check importState
 661      CALL ESMF_StateGet( importState, itemCount=itemCount, &
 662                          statetype=statetype, rc=rc )
 663      IF ( rc /= ESMF_SUCCESS ) THEN
 664        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed" )
 665      ENDIF
 666      WRITE (str,*) 'wrf_component_init2: importState itemCount = ', itemCount
 667      CALL wrf_debug ( 100 , TRIM(str) )
 668      IF ( statetype /= ESMF_STATE_IMPORT ) THEN
 669        CALL wrf_error_fatal("wrf_component_init2:  importState is not an import state" )
 670      ENDIF
 671
 672      p_gcomp => gcomp
 673      p_importState => importState
 674      p_exportState => exportState
 675      p_clock => clock
 676      ! NOTE:  It will be possible to remove this call once ESMF supports
 677      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 678      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 679      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 680                            exportState=p_exportState, clock=p_clock )
 681
 682      ! populate ESMF import and export states
 683      CALL wrf_state_populate( rc )
 684      IF ( rc /= 0 ) THEN
 685        CALL wrf_error_fatal ( 'wrf_component_init2:  wrf_state_populate failed' )
 686      ENDIF
 687
 688      ! examine importState
 689      WRITE (str,*) 'wrf_component_init2: EXAMINING importState...'
 690      CALL wrf_debug ( 100 , TRIM(str) )
 691      CALL ESMF_StateGet( importState, itemCount=itemCount, &
 692                          statetype=statetype, name=statename, rc=rc )
 693      IF ( rc /= ESMF_SUCCESS ) THEN
 694        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed B" )
 695      ENDIF
 696      IF ( statetype /= ESMF_STATE_IMPORT ) THEN
 697        CALL wrf_error_fatal("wrf_component_init2:  importState is not an import state" )
 698      ENDIF
 699      WRITE (str,*) 'wrf_component_init2: importState <',TRIM(statename), &
 700                    '> itemCount = ', itemCount
 701      CALL wrf_debug ( 100 , TRIM(str) )
 702      ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
 703      CALL ESMF_StateGet( importState, itemNameList=itemNames, &
 704                          stateitemtypeList=itemTypes, rc=rc )
 705      IF ( rc /= ESMF_SUCCESS ) THEN
 706        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed C" )
 707      ENDIF
 708      DO i=1, itemCount
 709        IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
 710          WRITE(str,*) 'wrf_component_init2: importState contains field <',TRIM(itemNames(i)),'>'
 711          CALL wrf_debug ( 100 , TRIM(str) )
 712        ENDIF
 713      ENDDO
 714      DEALLOCATE ( itemNames, itemTypes )
 715      WRITE (str,*) 'wrf_component_init2: DONE EXAMINING importState...'
 716      CALL wrf_debug ( 100 , TRIM(str) )
 717
 718      ! examine exportState
 719      WRITE (str,*) 'wrf_component_init2: EXAMINING exportState...'
 720      CALL wrf_debug ( 100 , TRIM(str) )
 721      CALL ESMF_StateGet( exportState, itemCount=itemCount, &
 722                          statetype=statetype, name=statename, rc=rc )
 723      IF ( rc /= ESMF_SUCCESS ) THEN
 724        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed B" )
 725      ENDIF
 726      IF ( statetype /= ESMF_STATE_EXPORT ) THEN
 727        CALL wrf_error_fatal("wrf_component_init2:  exportState is not an export state" )
 728      ENDIF
 729      WRITE (str,*) 'wrf_component_init2: exportState <',TRIM(statename), &
 730                    '> itemCount = ', itemCount
 731      CALL wrf_debug ( 100 , TRIM(str) )
 732      ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
 733      CALL ESMF_StateGet( exportState, itemNameList=itemNames, &
 734                          stateitemtypeList=itemTypes, rc=rc )
 735      IF ( rc /= ESMF_SUCCESS ) THEN
 736        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed C" )
 737      ENDIF
 738      DO i=1, itemCount
 739        IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
 740          WRITE(str,*) 'wrf_component_init2: exportState contains field <',TRIM(itemNames(i)),'>'
 741          CALL wrf_debug ( 100 , TRIM(str) )
 742        ENDIF
 743      ENDDO
 744      DEALLOCATE ( itemNames, itemTypes )
 745      WRITE (str,*) 'wrf_component_init2: DONE EXAMINING exportState...'
 746      CALL wrf_debug ( 100 , TRIM(str) )
 747
 748      CALL wrf_debug ( 100, 'DEBUG wrf_component_init2():  end' )
 749
 750    END SUBROUTINE wrf_component_init2
 751
 752
 753
 754    SUBROUTINE wrf_component_run( gcomp, importState, exportState, clock, rc )
 755      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 756      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
 757      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 758      INTEGER,                     INTENT(  OUT) :: rc
 759 !<DESCRIPTION>
 760 !     WRF component run routine.
 761 !
 762 !     The arguments are:
 763 !       gcomp           Component
 764 !       importState     Importstate
 765 !       exportState     Exportstate
 766 !       clock           External clock
 767 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 768 !                       otherwise ESMF_FAILURE.
 769 !</DESCRIPTION>
 770
 771      ! Local variables
 772      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 773      TYPE(ESMF_State),    POINTER :: p_importState
 774      TYPE(ESMF_State),    POINTER :: p_exportState
 775      TYPE(ESMF_Clock),    POINTER :: p_clock
 776      ! timing
 777      TYPE(ESMF_Time) :: currentTime, nextTime
 778      TYPE(ESMF_TimeInterval) :: runLength     ! how long to run in this call
 779      CHARACTER(LEN=256) :: timeStr
 780
 781      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  begin' )
 782
 783      p_gcomp => gcomp
 784      p_importState => importState
 785      p_exportState => exportState
 786      p_clock => clock
 787      ! NOTE:  It will be possible to remove this call once ESMF supports
 788      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 789      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 790      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 791                            exportState=p_exportState, clock=p_clock )
 792
 793      ! connect ESMF clock with WRF domain clock
 794      CALL ESMF_ClockGet( clock, currTime=currentTime, timeStep=runLength, rc=rc )
 795      IF ( rc /= ESMF_SUCCESS ) THEN
 796        CALL wrf_error_fatal ( 'wrf_component_run:  ESMF_ClockGet failed' )
 797      ENDIF
 798      CALL wrf_clockprint(100, clock, &
 799             'DEBUG wrf_component_run():  clock,')
 800      nextTime = currentTime + runLength
 801      head_grid%start_subtime = currentTime
 802      head_grid%stop_subtime = nextTime
 803      CALL wrf_timetoa ( head_grid%start_subtime, timeStr )
 804      WRITE (str,*) 'wrf_component_run:  head_grid%start_subtime ',TRIM(timeStr)
 805      CALL wrf_debug ( 100 , TRIM(str) )
 806      CALL wrf_timetoa ( head_grid%stop_subtime, timeStr )
 807      WRITE (str,*) 'wrf_component_run:  head_grid%stop_subtime ',TRIM(timeStr)
 808      CALL wrf_debug ( 100 , TRIM(str) )
 809
 810      ! Call WRF "run" routine
 811      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  calling wrf_run()' )
 812      CALL wrf_run( )
 813      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  back from wrf_run()' )
 814
 815      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  end' )
 816
 817    END SUBROUTINE wrf_component_run
 818
 819
 820
 821    SUBROUTINE wrf_component_finalize( gcomp, importState, exportState, clock, rc )
 822      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 823      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
 824      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 825      INTEGER,                     INTENT(  OUT) :: rc
 826 !<DESCRIPTION>
 827 !     WRF component finalize routine.
 828 !
 829 !     The arguments are:
 830 !       gcomp           Component
 831 !       importState     Importstate
 832 !       exportState     Exportstate
 833 !       clock           External clock
 834 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 835 !                       otherwise ESMF_FAILURE.
 836 !</DESCRIPTION>
 837
 838      ! Local variables
 839      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 840      TYPE(ESMF_State),    POINTER :: p_importState
 841      TYPE(ESMF_State),    POINTER :: p_exportState
 842      TYPE(ESMF_Clock),    POINTER :: p_clock
 843      INTEGER :: rc
 844      p_gcomp => gcomp
 845      p_importState => importState
 846      p_exportState => exportState
 847      p_clock => clock
 848      ! NOTE:  It will be possible to remove this call once ESMF supports
 849      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 850      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 851      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 852                            exportState=p_exportState, clock=p_clock )
 853
 854      ! Call WRF "finalize" routine, suppressing call to MPI_FINALIZE so
 855      ! ESMF can do it (if needed) during ESMF_Finalize().
 856      CALL wrf_finalize( no_shutdown=.TRUE. )
 857
 858      rc = ESMF_SUCCESS
 859
 860    END SUBROUTINE wrf_component_finalize
 861
 862
 863
 864    SUBROUTINE wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
 865      TYPE(ESMF_Time),         INTENT(IN   ) :: startTime
 866      TYPE(ESMF_Time),         INTENT(IN   ) :: stopTime
 867      TYPE(ESMF_TimeInterval), INTENT(  OUT) :: couplingInterval
 868 !<DESCRIPTION>
 869 !     WRF convenience routine for deducing coupling interval.  The startTime
 870 !     and stopTime arguments are only used for determining a default value
 871 !     when coupling is not actually being done.
 872 !
 873 !     The arguments are:
 874 !       startTime          start time
 875 !       stopTime           stop time
 876 !       couplingInterval   coupling interval
 877 !</DESCRIPTION>
 878      ! locals
 879      LOGICAL :: foundcoupling
 880      INTEGER :: rc
 881      INTEGER :: io_form
 882      ! external function prototype
 883      INTEGER, EXTERNAL :: use_package
 884
 885      ! deduce coupling time-step
 886      foundcoupling = .FALSE.
 887 !TODO:  This bit just finds the FIRST case and extracts coupling interval...
 888 !TODO:  Add error-checking for over-specification.
 889 !TODO:  Add support for multiple coupling intervals later...
 890 !TODO:  Add support for coupling that does not begin immediately later...
 891 !TODO:  Get rid of duplication once I/O refactoring is finished (and
 892 !TODO:  auxio streams can be addressed via index).
 893      IF ( .NOT. foundcoupling ) THEN
 894        CALL nl_get_io_form_auxinput1( 1, io_form )
 895        IF ( use_package( io_form ) == IO_ESMF ) THEN
 896          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT1_ALARM ), &
 897                              RingInterval=couplingInterval, rc=rc )
 898          IF ( rc /= ESMF_SUCCESS ) THEN
 899            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT1_ALARM) failed' )
 900          ENDIF
 901          foundcoupling = .TRUE.
 902        ENDIF
 903      ENDIF
 904      IF ( .NOT. foundcoupling ) THEN
 905        CALL nl_get_io_form_auxinput2( 1, io_form )
 906        IF ( use_package( io_form ) == IO_ESMF ) THEN
 907          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT2_ALARM ), &
 908                              RingInterval=couplingInterval, rc=rc )
 909          IF ( rc /= ESMF_SUCCESS ) THEN
 910            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT2_ALARM) failed' )
 911          ENDIF
 912          foundcoupling = .TRUE.
 913        ENDIF
 914      ENDIF
 915      IF ( .NOT. foundcoupling ) THEN
 916        CALL nl_get_io_form_auxinput3( 1, io_form )
 917        IF ( use_package( io_form ) == IO_ESMF ) THEN
 918          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT3_ALARM ), &
 919                              RingInterval=couplingInterval, rc=rc )
 920          IF ( rc /= ESMF_SUCCESS ) THEN
 921            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT3_ALARM) failed' )
 922          ENDIF
 923          foundcoupling = .TRUE.
 924        ENDIF
 925      ENDIF
 926      IF ( .NOT. foundcoupling ) THEN
 927        CALL nl_get_io_form_auxinput4( 1, io_form )
 928        IF ( use_package( io_form ) == IO_ESMF ) THEN
 929          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT4_ALARM ), &
 930                              RingInterval=couplingInterval, rc=rc )
 931          IF ( rc /= ESMF_SUCCESS ) THEN
 932            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT4_ALARM) failed' )
 933          ENDIF
 934          foundcoupling = .TRUE.
 935        ENDIF
 936      ENDIF
 937      IF ( .NOT. foundcoupling ) THEN
 938        CALL nl_get_io_form_auxinput5( 1, io_form )
 939        IF ( use_package( io_form ) == IO_ESMF ) THEN
 940          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT5_ALARM ), &
 941                              RingInterval=couplingInterval, rc=rc )
 942          IF ( rc /= ESMF_SUCCESS ) THEN
 943            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT5_ALARM) failed' )
 944          ENDIF
 945          foundcoupling = .TRUE.
 946        ENDIF
 947      ENDIF
 948      IF ( .NOT. foundcoupling ) THEN
 949        CALL nl_get_io_form_auxinput6( 1, io_form )
 950        IF ( use_package( io_form ) == IO_ESMF ) THEN
 951          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT6_ALARM ), &
 952                              RingInterval=couplingInterval, rc=rc )
 953          IF ( rc /= ESMF_SUCCESS ) THEN
 954            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT6_ALARM) failed' )
 955          ENDIF
 956          foundcoupling = .TRUE.
 957        ENDIF
 958      ENDIF
 959      IF ( .NOT. foundcoupling ) THEN
 960        CALL nl_get_io_form_auxinput7( 1, io_form )
 961        IF ( use_package( io_form ) == IO_ESMF ) THEN
 962          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT7_ALARM ), &
 963                              RingInterval=couplingInterval, rc=rc )
 964          IF ( rc /= ESMF_SUCCESS ) THEN
 965            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT7_ALARM) failed' )
 966          ENDIF
 967          foundcoupling = .TRUE.
 968        ENDIF
 969      ENDIF
 970      IF ( .NOT. foundcoupling ) THEN
 971        CALL nl_get_io_form_auxinput8( 1, io_form )
 972        IF ( use_package( io_form ) == IO_ESMF ) THEN
 973          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT8_ALARM ), &
 974                              RingInterval=couplingInterval, rc=rc )
 975          IF ( rc /= ESMF_SUCCESS ) THEN
 976            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT8_ALARM) failed' )
 977          ENDIF
 978          foundcoupling = .TRUE.
 979        ENDIF
 980      ENDIF
 981      IF ( .NOT. foundcoupling ) THEN
 982        CALL nl_get_io_form_auxinput9( 1, io_form )
 983        IF ( use_package( io_form ) == IO_ESMF ) THEN
 984          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT9_ALARM ), &
 985                              RingInterval=couplingInterval, rc=rc )
 986          IF ( rc /= ESMF_SUCCESS ) THEN
 987            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT9_ALARM) failed' )
 988          ENDIF
 989          foundcoupling = .TRUE.
 990        ENDIF
 991      ENDIF
 992      IF ( .NOT. foundcoupling ) THEN
 993        CALL nl_get_io_form_gfdda( 1, io_form )
 994        IF ( use_package( io_form ) == IO_ESMF ) THEN
 995          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT10_ALARM ), &
 996                              RingInterval=couplingInterval, rc=rc )
 997          IF ( rc /= ESMF_SUCCESS ) THEN
 998            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT10_ALARM) failed' )
 999          ENDIF
1000          foundcoupling = .TRUE.
1001        ENDIF
1002      ENDIF
1003      IF ( .NOT. foundcoupling ) THEN
1004        CALL nl_get_io_form_auxinput11( 1, io_form )
1005        IF ( use_package( io_form ) == IO_ESMF ) THEN
1006          CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT11_ALARM ), &
1007                              RingInterval=couplingInterval, rc=rc )
1008          IF ( rc /= ESMF_SUCCESS ) THEN
1009            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXINPUT11_ALARM) failed' )
1010          ENDIF
1011          foundcoupling = .TRUE.
1012        ENDIF
1013      ENDIF
1014
1015
1016      IF ( .NOT. foundcoupling ) THEN
1017        CALL nl_get_io_form_auxhist1( 1, io_form )
1018        IF ( use_package( io_form ) == IO_ESMF ) THEN
1019          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST1_ALARM ), &
1020                              RingInterval=couplingInterval, rc=rc )
1021          IF ( rc /= ESMF_SUCCESS ) THEN
1022            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST1_ALARM) failed' )
1023          ENDIF
1024          foundcoupling = .TRUE.
1025        ENDIF
1026      ENDIF
1027      IF ( .NOT. foundcoupling ) THEN
1028        CALL nl_get_io_form_auxhist2( 1, io_form )
1029        IF ( use_package( io_form ) == IO_ESMF ) THEN
1030          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST2_ALARM ), &
1031                              RingInterval=couplingInterval, rc=rc )
1032          IF ( rc /= ESMF_SUCCESS ) THEN
1033            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST2_ALARM) failed' )
1034          ENDIF
1035          foundcoupling = .TRUE.
1036        ENDIF
1037      ENDIF
1038      IF ( .NOT. foundcoupling ) THEN
1039        CALL nl_get_io_form_auxhist3( 1, io_form )
1040        IF ( use_package( io_form ) == IO_ESMF ) THEN
1041          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST3_ALARM ), &
1042                              RingInterval=couplingInterval, rc=rc )
1043          IF ( rc /= ESMF_SUCCESS ) THEN
1044            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST3_ALARM) failed' )
1045          ENDIF
1046          foundcoupling = .TRUE.
1047        ENDIF
1048      ENDIF
1049      IF ( .NOT. foundcoupling ) THEN
1050        CALL nl_get_io_form_auxhist4( 1, io_form )
1051        IF ( use_package( io_form ) == IO_ESMF ) THEN
1052          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST4_ALARM ), &
1053                              RingInterval=couplingInterval, rc=rc )
1054          IF ( rc /= ESMF_SUCCESS ) THEN
1055            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST4_ALARM) failed' )
1056          ENDIF
1057          foundcoupling = .TRUE.
1058        ENDIF
1059      ENDIF
1060      IF ( .NOT. foundcoupling ) THEN
1061        CALL nl_get_io_form_auxhist5( 1, io_form )
1062        IF ( use_package( io_form ) == IO_ESMF ) THEN
1063          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST5_ALARM ), &
1064                              RingInterval=couplingInterval, rc=rc )
1065          IF ( rc /= ESMF_SUCCESS ) THEN
1066            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST5_ALARM) failed' )
1067          ENDIF
1068          foundcoupling = .TRUE.
1069        ENDIF
1070      ENDIF
1071      IF ( .NOT. foundcoupling ) THEN
1072        CALL nl_get_io_form_auxhist6( 1, io_form )
1073        IF ( use_package( io_form ) == IO_ESMF ) THEN
1074          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST6_ALARM ), &
1075                              RingInterval=couplingInterval, rc=rc )
1076          IF ( rc /= ESMF_SUCCESS ) THEN
1077            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST6_ALARM) failed' )
1078          ENDIF
1079          foundcoupling = .TRUE.
1080        ENDIF
1081      ENDIF
1082      IF ( .NOT. foundcoupling ) THEN
1083        CALL nl_get_io_form_auxhist7( 1, io_form )
1084        IF ( use_package( io_form ) == IO_ESMF ) THEN
1085          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST7_ALARM ), &
1086                              RingInterval=couplingInterval, rc=rc )
1087          IF ( rc /= ESMF_SUCCESS ) THEN
1088            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST7_ALARM) failed' )
1089          ENDIF
1090          foundcoupling = .TRUE.
1091        ENDIF
1092      ENDIF
1093      IF ( .NOT. foundcoupling ) THEN
1094        CALL nl_get_io_form_auxhist8( 1, io_form )
1095        IF ( use_package( io_form ) == IO_ESMF ) THEN
1096          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST8_ALARM ), &
1097                              RingInterval=couplingInterval, rc=rc )
1098          IF ( rc /= ESMF_SUCCESS ) THEN
1099            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST8_ALARM) failed' )
1100          ENDIF
1101          foundcoupling = .TRUE.
1102        ENDIF
1103      ENDIF
1104      IF ( .NOT. foundcoupling ) THEN
1105        CALL nl_get_io_form_auxhist9( 1, io_form )
1106        IF ( use_package( io_form ) == IO_ESMF ) THEN
1107          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST9_ALARM ), &
1108                              RingInterval=couplingInterval, rc=rc )
1109          IF ( rc /= ESMF_SUCCESS ) THEN
1110            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST9_ALARM) failed' )
1111          ENDIF
1112          foundcoupling = .TRUE.
1113        ENDIF
1114      ENDIF
1115      IF ( .NOT. foundcoupling ) THEN
1116        CALL nl_get_io_form_auxhist10( 1, io_form )
1117        IF ( use_package( io_form ) == IO_ESMF ) THEN
1118          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST10_ALARM ), &
1119                              RingInterval=couplingInterval, rc=rc )
1120          IF ( rc /= ESMF_SUCCESS ) THEN
1121            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST10_ALARM) failed' )
1122          ENDIF
1123          foundcoupling = .TRUE.
1124        ENDIF
1125      ENDIF
1126      IF ( .NOT. foundcoupling ) THEN
1127        CALL nl_get_io_form_auxhist11( 1, io_form )
1128        IF ( use_package( io_form ) == IO_ESMF ) THEN
1129          CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST11_ALARM ), &
1130                              RingInterval=couplingInterval, rc=rc )
1131          IF ( rc /= ESMF_SUCCESS ) THEN
1132            CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ESMF_AlarmGet(AUXHIST11_ALARM) failed' )
1133          ENDIF
1134          foundcoupling = .TRUE.
1135        ENDIF
1136      ENDIF
1137
1138      ! look for erroneous use of io_form...
1139      CALL nl_get_io_form_restart( 1, io_form )
1140      IF ( use_package( io_form ) == IO_ESMF ) THEN
1141        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF restart I/O' )
1142      ENDIF
1143      CALL nl_get_io_form_input( 1, io_form )
1144      IF ( use_package( io_form ) == IO_ESMF ) THEN
1145        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF input' )
1146      ENDIF
1147      CALL nl_get_io_form_history( 1, io_form )
1148      IF ( use_package( io_form ) == IO_ESMF ) THEN
1149        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF history output' )
1150      ENDIF
1151      CALL nl_get_io_form_boundary( 1, io_form )
1152      IF ( use_package( io_form ) == IO_ESMF ) THEN
1153        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF boundary I/O' )
1154      ENDIF
1155
1156      ! If nobody uses IO_ESMF, then default is to run WRF all the way to
1157      ! the end.
1158      IF ( .NOT. foundcoupling ) THEN
1159        couplingInterval = stopTime - startTime
1160        call wrf_debug ( 1, 'WARNING:  ESMF coupling not used in this WRF run' )
1161      ENDIF
1162
1163    END SUBROUTINE wrf_findCouplingInterval
1164
1165
1166
1167    SUBROUTINE wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
1168                                  ims, ime, jms, jme, kms, kme, &
1169                                  ips, ipe, jps, jpe, kps, kpe, &
1170                                  domdesc, bdy_mask )
1171      INTEGER, INTENT(OUT) :: ids, ide, jds, jde, kds, kde
1172      INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme
1173      INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe
1174      INTEGER, INTENT(OUT) :: domdesc
1175      LOGICAL, INTENT(OUT) :: bdy_mask(4)
1176 !<DESCRIPTION>
1177 !     WRF convenience routine for deducing decomposition information.
1178 !TODO:  Note that domdesc is meaningful only for SPMD alternating event loops.
1179 !TODO:  For concurrent operation (SPMD or MPMD), we will need to create a new
1180 !TODO:  "domdesc" suitable for the task layout of the SST component.  For
1181 !TODO:  MPMD alternating event loops, we will need to serialize domdesc and
1182 !TODO:  store it as metadata within the export state.  Similar arguments apply
1183 !TODO:  to [ij][mp][se] and bdy_mask.
1184 !
1185 !     The arguments are:
1186 !       ids, ide, jds, jde, kds, kde    Domain extent.
1187 !       ims, ime, jms, jme, kms, kme    Memory extent.
1188 !       ips, ipe, jps, jpe, kps, kpe    Patch extent.
1189 !       domdesc                         Domain descriptor for external
1190 !                                       distributed-memory communication
1191 !                                       package (opaque to WRF).
1192 !       bdy_mask                        Boundary mask flags indicating which
1193 !                                       domain boundaries are on this task.
1194 !</DESCRIPTION>
1195      ! extract decomposition information from head_grid
1196      CALL get_ijk_from_grid( head_grid ,                   &
1197                              ids, ide, jds, jde, kds, kde, &
1198                              ims, ime, jms, jme, kms, kme, &
1199                              ips, ipe, jps, jpe, kps, kpe  )
1200 ! JM
1201 ! with version 3 of ESMF's staggering concepts, WRF's non-staggered grid is equivalent to
1202 ! esmf's 'exclusive' region -- that is the set of points that are owned by the 'DE' (eyeroll)
1203 ! WRF, on the other hand, is returning the 'staggered' dimensions here.  So convert to the
1204 ! unstaggered dims before returning.
1205 ! Don't bother with vertical dimension for the time being, since we're only doing 2D coupling.
1206 !
1207
1208      ide = ide-1 ; ipe = MIN(ide,ipe)
1209      jde = jde-1 ; jpe = MIN(jde,jpe)
1210
1211      domdesc = head_grid%domdesc
1212      bdy_mask = head_grid%bdy_mask
1213    END SUBROUTINE wrf_getDecompInfo
1214
1215
1216    SUBROUTINE wrf_state_populate( ierr )
1217      ! Driver layer
1218      USE module_domain, ONLY : domain
1219      USE module_io_domain
1220      ! Model layer
1221      USE module_configure, ONLY : grid_config_rec_type, model_to_grid_config_rec
1222      USE module_bc_time_utilities
1223
1224      IMPLICIT NONE
1225
1226 !<DESCRIPTION>
1227 !     Populate WRF import and export states from Registry-generated code.
1228 !     For now, only head_grid can be coupled.
1229 !
1230 !</DESCRIPTION>
1231 !TODO:  Extend later to include child
1232 !TODO:  domains, possibly via nested ESMF_State's.
1233
1234      ! Arguments
1235      INTEGER, INTENT(OUT)       :: ierr
1236      ! Local
1237      TYPE(domain), POINTER      :: grid
1238      TYPE(grid_config_rec_type) :: config_flags
1239      INTEGER                    :: stream, idum1, idum2, io_form
1240      CHARACTER*80               :: fname, n2
1241      ! external function prototype
1242      INTEGER, EXTERNAL          :: use_package
1243
1244      ! for now support coupling to head_grid only
1245      grid => head_grid
1246 ! TODO:  Use actual grid via current_grid%id via something like this...
1247 !  IF ( current_grid_set ) THEN
1248 !    grid => current_grid
1249 !  ELSE
1250 !    ERROR
1251 !  ENDIF
1252
1253      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
1254      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
1255
1256      stream = 0
1257      ierr = 0
1258
1259      ! "Loop" over auxin streams mucking with io_esmf streams only...  Ick.
1260      ! Would need to store function pointers in an array in order to put this
1261      ! in a loop...
1262      CALL nl_get_io_form_auxinput1( 1, io_form )
1263      IF ( use_package( io_form ) == IO_ESMF ) THEN
1264        stream = 1
1265        CALL open_aux_u( grid, config_flags, stream, AUXINPUT1_ALARM,       &
1266                         config_flags%auxinput1_inname, grid%auxinput1_oid, &
1267                         input_aux_model_input1, ierr )
1268        IF ( ierr /= 0 ) RETURN
1269      ENDIF
1270      CALL nl_get_io_form_auxinput2( 1, io_form )
1271      IF ( use_package( io_form ) == IO_ESMF ) THEN
1272        stream = 2
1273        CALL open_aux_u( grid, config_flags, stream, AUXINPUT2_ALARM,       &
1274                         config_flags%auxinput2_inname, grid%auxinput2_oid, &
1275                         input_aux_model_input2, ierr )
1276        IF ( ierr /= 0 ) RETURN
1277      ENDIF
1278      CALL nl_get_io_form_auxinput3( 1, io_form )
1279      IF ( use_package( io_form ) == IO_ESMF ) THEN
1280        stream = 3
1281        CALL open_aux_u( grid, config_flags, stream, AUXINPUT3_ALARM,       &
1282                         config_flags%auxinput3_inname, grid%auxinput3_oid, &
1283                         input_aux_model_input3, ierr )
1284        IF ( ierr /= 0 ) RETURN
1285      ENDIF
1286      CALL nl_get_io_form_auxinput4( 1, io_form )
1287      IF ( use_package( io_form ) == IO_ESMF ) THEN
1288        stream = 4
1289        CALL open_aux_u( grid, config_flags, stream, AUXINPUT4_ALARM,       &
1290                         config_flags%auxinput4_inname, grid%auxinput4_oid, &
1291                         input_aux_model_input4, ierr )
1292        IF ( ierr /= 0 ) RETURN
1293      ENDIF
1294      CALL nl_get_io_form_auxinput5( 1, io_form )
1295      IF ( use_package( io_form ) == IO_ESMF ) THEN
1296        stream = 5
1297        CALL open_aux_u( grid, config_flags, stream, AUXINPUT5_ALARM,       &
1298                         config_flags%auxinput5_inname, grid%auxinput5_oid, &
1299                         input_aux_model_input5, ierr )
1300        IF ( ierr /= 0 ) RETURN
1301      ENDIF
1302      CALL nl_get_io_form_auxinput6( 1, io_form )
1303      IF ( use_package( io_form ) == IO_ESMF ) THEN
1304        stream = 6
1305        CALL open_aux_u( grid, config_flags, stream, AUXINPUT6_ALARM,       &
1306                         config_flags%auxinput6_inname, grid%auxinput6_oid, &
1307                         input_aux_model_input6, ierr )
1308        IF ( ierr /= 0 ) RETURN
1309      ENDIF
1310      CALL nl_get_io_form_auxinput7( 1, io_form )
1311      IF ( use_package( io_form ) == IO_ESMF ) THEN
1312        stream = 7
1313        CALL open_aux_u( grid, config_flags, stream, AUXINPUT7_ALARM,       &
1314                         config_flags%auxinput7_inname, grid%auxinput7_oid, &
1315                         input_aux_model_input7, ierr )
1316        IF ( ierr /= 0 ) RETURN
1317      ENDIF
1318      CALL nl_get_io_form_auxinput8( 1, io_form )
1319      IF ( use_package( io_form ) == IO_ESMF ) THEN
1320        stream = 8
1321        CALL open_aux_u( grid, config_flags, stream, AUXINPUT8_ALARM,       &
1322                         config_flags%auxinput8_inname, grid%auxinput8_oid, &
1323                         input_aux_model_input8, ierr )
1324        IF ( ierr /= 0 ) RETURN
1325      ENDIF
1326      CALL nl_get_io_form_auxinput9( 1, io_form )
1327      IF ( use_package( io_form ) == IO_ESMF ) THEN
1328        stream = 9
1329        CALL open_aux_u( grid, config_flags, stream, AUXINPUT9_ALARM,       &
1330                         config_flags%auxinput9_inname, grid%auxinput9_oid, &
1331                         input_aux_model_input9, ierr )
1332        IF ( ierr /= 0 ) RETURN
1333      ENDIF
1334      CALL nl_get_io_form_gfdda( 1, io_form )
1335      IF ( use_package( io_form ) == IO_ESMF ) THEN
1336        stream = 10
1337        CALL open_aux_u( grid, config_flags, stream, AUXINPUT10_ALARM,   &
1338                         config_flags%gfdda_inname, grid%auxinput10_oid, &
1339                         input_aux_model_input10, ierr )
1340        IF ( ierr /= 0 ) RETURN
1341      ENDIF
1342      CALL nl_get_io_form_auxinput11( 1, io_form )
1343      IF ( use_package( io_form ) == IO_ESMF ) THEN
1344        stream = 11
1345        CALL open_aux_u( grid, config_flags, stream, AUXINPUT11_ALARM,        &
1346                         config_flags%auxinput11_inname, grid%auxinput11_oid, &
1347                         input_aux_model_input11, ierr )
1348        IF ( ierr /= 0 ) RETURN
1349      ENDIF
1350
1351      ! "Loop" over history streams mucking with io_esmf streams only...  Ick.
1352      ! Would need to store function pointers in an array in order to put this
1353      ! in a loop...
1354      CALL nl_get_io_form_auxhist1( 1, io_form )
1355      IF ( use_package( io_form ) == IO_ESMF ) THEN
1356        stream = 1
1357        CALL open_hist_w( grid, config_flags, stream, AUXHIST1_ALARM,       &
1358                          config_flags%auxhist1_outname, grid%auxhist1_oid, &
1359                          output_aux_hist1, fname, n2, ierr )
1360        IF ( ierr /= 0 ) RETURN
1361      ENDIF
1362      CALL nl_get_io_form_auxhist2( 1, io_form )
1363      IF ( use_package( io_form ) == IO_ESMF ) THEN
1364        stream = 2
1365        CALL open_hist_w( grid, config_flags, stream, AUXHIST2_ALARM,       &
1366                          config_flags%auxhist2_outname, grid%auxhist2_oid, &
1367                          output_aux_hist2, fname, n2, ierr )
1368        IF ( ierr /= 0 ) RETURN
1369      ENDIF
1370      CALL nl_get_io_form_auxhist3( 1, io_form )
1371      IF ( use_package( io_form ) == IO_ESMF ) THEN
1372        stream = 3
1373        CALL open_hist_w( grid, config_flags, stream, AUXHIST3_ALARM,       &
1374                          config_flags%auxhist3_outname, grid%auxhist3_oid, &
1375                          output_aux_hist3, fname, n2, ierr )
1376        IF ( ierr /= 0 ) RETURN
1377      ENDIF
1378      CALL nl_get_io_form_auxhist4( 1, io_form )
1379      IF ( use_package( io_form ) == IO_ESMF ) THEN
1380        stream = 4
1381        CALL open_hist_w( grid, config_flags, stream, AUXHIST4_ALARM,       &
1382                          config_flags%auxhist4_outname, grid%auxhist4_oid, &
1383                          output_aux_hist4, fname, n2, ierr )
1384        IF ( ierr /= 0 ) RETURN
1385      ENDIF
1386      CALL nl_get_io_form_auxhist5( 1, io_form )
1387      IF ( use_package( io_form ) == IO_ESMF ) THEN
1388        stream = 5
1389        CALL open_hist_w( grid, config_flags, stream, AUXHIST5_ALARM,       &
1390                          config_flags%auxhist5_outname, grid%auxhist5_oid, &
1391                          output_aux_hist5, fname, n2, ierr )
1392        IF ( ierr /= 0 ) RETURN
1393      ENDIF
1394      CALL nl_get_io_form_auxhist6( 1, io_form )
1395      IF ( use_package( io_form ) == IO_ESMF ) THEN
1396        stream = 6
1397        CALL open_hist_w( grid, config_flags, stream, AUXHIST6_ALARM,       &
1398                          config_flags%auxhist6_outname, grid%auxhist6_oid, &
1399                          output_aux_hist6, fname, n2, ierr )
1400        IF ( ierr /= 0 ) RETURN
1401      ENDIF
1402      CALL nl_get_io_form_auxhist7( 1, io_form )
1403      IF ( use_package( io_form ) == IO_ESMF ) THEN
1404        stream = 7
1405        CALL open_hist_w( grid, config_flags, stream, AUXHIST7_ALARM,       &
1406                          config_flags%auxhist7_outname, grid%auxhist7_oid, &
1407                          output_aux_hist7, fname, n2, ierr )
1408        IF ( ierr /= 0 ) RETURN
1409      ENDIF
1410      CALL nl_get_io_form_auxhist8( 1, io_form )
1411      IF ( use_package( io_form ) == IO_ESMF ) THEN
1412        stream = 8
1413        CALL open_hist_w( grid, config_flags, stream, AUXHIST8_ALARM,       &
1414                          config_flags%auxhist8_outname, grid%auxhist8_oid, &
1415                          output_aux_hist8, fname, n2, ierr )
1416        IF ( ierr /= 0 ) RETURN
1417      ENDIF
1418      CALL nl_get_io_form_auxhist9( 1, io_form )
1419      IF ( use_package( io_form ) == IO_ESMF ) THEN
1420        stream = 9
1421        CALL open_hist_w( grid, config_flags, stream, AUXHIST9_ALARM,       &
1422                          config_flags%auxhist9_outname, grid%auxhist9_oid, &
1423                          output_aux_hist9, fname, n2, ierr )
1424        IF ( ierr /= 0 ) RETURN
1425      ENDIF
1426      CALL nl_get_io_form_auxhist10( 1, io_form )
1427      IF ( use_package( io_form ) == IO_ESMF ) THEN
1428        stream = 10
1429        CALL open_hist_w( grid, config_flags, stream, AUXHIST10_ALARM,        &
1430                          config_flags%auxhist10_outname, grid%auxhist10_oid, &
1431                          output_aux_hist10, fname, n2, ierr )
1432        IF ( ierr /= 0 ) RETURN
1433      ENDIF
1434      CALL nl_get_io_form_auxhist11( 1, io_form )
1435      IF ( use_package( io_form ) == IO_ESMF ) THEN
1436        stream = 11
1437        CALL open_hist_w( grid, config_flags, stream, AUXHIST11_ALARM,        &
1438                          config_flags%auxhist11_outname, grid%auxhist11_oid, &
1439                          output_aux_hist11, fname, n2, ierr )
1440        IF ( ierr /= 0 ) RETURN
1441      ENDIF
1442    END SUBROUTINE wrf_state_populate
1443
1444 END MODULE module_wrf_component_top
1445
1446
1447
1448 MODULE module_wrf_setservices
1449 !<DESCRIPTION>
1450 ! This module defines WRF "Set Services" method wrf_register()
1451 ! used for ESMF coupling.
1452 !</DESCRIPTION>
1453
1454    USE module_wrf_component_top, ONLY: wrf_component_init1, &
1455                                        wrf_component_init2, &
1456                                        wrf_component_run,   &
1457                                        wrf_component_finalize
1458    USE ESMF_Mod
1459
1460    IMPLICIT NONE
1461
1462    ! everything is private by default
1463    PRIVATE
1464
1465    ! Public entry point for ESMF_GridCompSetServices()
1466    PUBLIC WRF_register
1467
1468    ! private stuff
1469    CHARACTER (ESMF_MAXSTR) :: str
1470
1471 CONTAINS
1472
1473
1474    SUBROUTINE wrf_register(gcomp, rc)
1475      TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
1476      INTEGER, INTENT(OUT) :: rc
1477 !
1478 !<DESCRIPTION>
1479 !     WRF_register - Externally visible registration routine
1480 !
1481 !     User-supplied SetServices routine.
1482 !     The Register routine sets the subroutines to be called
1483 !     as the init, run, and finalize routines.  Note that these are
1484 !     private to the module.
1485 !
1486 !     The arguments are:
1487 !       gcomp           Component
1488 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
1489 !                       otherwise ESMF_FAILURE.
1490 !</DESCRIPTION>
1491
1492      rc = ESMF_SUCCESS
1493      ! Register the callback routines.
1494      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1495                                      wrf_component_init1, 1, rc)
1496      IF ( rc /= ESMF_SUCCESS) THEN
1497         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_init1) failed' )
1498      ENDIF
1499      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1500                                      wrf_component_init2, 2, rc)
1501      IF ( rc /= ESMF_SUCCESS) THEN
1502         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_init2) failed' )
1503      ENDIF
1504      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
1505                                      wrf_component_run, ESMF_SINGLEPHASE, rc)
1506      IF ( rc /= ESMF_SUCCESS) THEN
1507         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_run) failed' )
1508      ENDIF
1509      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, &
1510                                      wrf_component_finalize, ESMF_SINGLEPHASE, rc)
1511      IF ( rc /= ESMF_SUCCESS) THEN
1512         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_finalize) failed' )
1513      ENDIF
1514      PRINT *,'WRF:  Registered Initialize, Run, and Finalize routines'
1515
1516    END SUBROUTINE wrf_register
1517
1518 END MODULE module_wrf_setservices
1519