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
  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', timevals, itemCount=SIZE(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', timevals, itemCount=SIZE(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', timevals, itemCount=SIZE(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(INOUT) :: 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      INTEGER :: thecount  ! 'one attribute ... ah ah ah. TWO attributes!  ah ah ah!!
 129      CHARACTER*256 mess
 130      ! start time
 131      thecount = SIZE(timevals)
 132      CALL ESMF_AttributeGet(state, 'ComponentStartTime', timevals, itemCount=thecount, rc=rc)
 133      IF ( rc /= ESMF_SUCCESS ) THEN
 134 !JM return but don't fail; let the caller figure out what to do
 135        RETURN
 136      ENDIF
 137      year   = timevals(1)
 138      month  = timevals(2)
 139      day    = timevals(3)
 140      hour   = timevals(4)
 141      minute = timevals(5)
 142      second = timevals(6)
 143      CALL ESMF_TimeSet(startTime, yy=year, mm=month, dd=day, &
 144                        h=hour, m=minute, s=second, rc=rc)
 145      IF ( rc /= ESMF_SUCCESS ) THEN
 146        CALL wrf_error_fatal ( 'ESMF_TimeSet(startTime) failed' )
 147      ENDIF
 148      ! stop time
 149      thecount = SIZE(timevals)
 150      CALL ESMF_AttributeGet(state, 'ComponentStopTime', timevals, itemCount=thecount, rc=rc)
 151      IF ( rc /= ESMF_SUCCESS ) THEN
 152 !JM return but don't fail; let the caller figure out what to do
 153        !CALL wrf_error_fatal ( 'ESMF_AttributeGet(ComponentStopTime) failed' )
 154        RETURN
 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      CALL ESMF_TimeSet(stopTime, yy=year, mm=month, dd=day, &
 163                        h=hour, m=minute, s=second, rc=rc)
 164      IF ( rc /= ESMF_SUCCESS ) THEN
 165        CALL wrf_error_fatal ( 'ESMF_TimeSet(stopTime) failed' )
 166      ENDIF
 167      ! coupling time step
 168      thecount = SIZE(timevals)
 169      CALL ESMF_AttributeGet(state, 'ComponentCouplingInterval', timevals, itemCount=thecount, rc=rc)
 170      IF ( rc /= ESMF_SUCCESS ) THEN
 171 !JM return but don't fail; let the caller figure out what to do
 172        !CALL wrf_error_fatal ( 'ESMF_AttributeGet(ComponentCouplingInterval) failed' )
 173        RETURN
 174      ENDIF
 175      year   = timevals(1)
 176      month  = timevals(2)
 177      day    = timevals(3)
 178      hour   = timevals(4)
 179      minute = timevals(5)
 180      second = timevals(6)
 181      CALL ESMF_TimeIntervalSet(couplingInterval, yy=year, mm=month, d=day, &
 182                                h=hour, m=minute, s=second, rc=rc)
 183      IF ( rc /= ESMF_SUCCESS ) THEN
 184        CALL wrf_error_fatal ( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
 185      ENDIF
 186    END SUBROUTINE GetTimesFromState
 187
 188
 189
 190    ! Extract time information attached as meta-data from one or more
 191    ! ESMF_States.  To use this with more than one ESMF_State, put the
 192    ! ESMF_States into a single ESMF_State.  If times differ, an attempt
 193    ! is made to reconcile them.
 194    SUBROUTINE GetTimesFromStates( state, startTime, stopTime, couplingInterval )
 195    USE ESMF
 196      TYPE(ESMF_State),        INTENT(INOUT) :: state
 197      TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
 198      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
 199      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
 200      ! locals
 201      INTEGER :: rc
 202      INTEGER :: numItems, numStates, i, istate
 203      TYPE(ESMF_StateItem_Flag), ALLOCATABLE :: itemTypes(:)
 204      TYPE(ESMF_State) :: tmpState
 205      CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
 206      TYPE(ESMF_Time),         ALLOCATABLE :: startTimes(:)
 207      TYPE(ESMF_Time),         ALLOCATABLE :: stopTimes(:)
 208      TYPE(ESMF_TimeInterval), ALLOCATABLE :: couplingIntervals(:)
 209      CHARACTER (len=132) :: mess
 210
 211 ! Unfortunately, implementing this is unnecessarily difficult due
 212 ! to lack of Iterators for ESMF_State.
 213
 214      ! Since there are no convenient iterators for ESMF_State,
 215      ! write a lot of code...
 216      ! Figure out how many items are in the ESMF_State
 217      CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
 218      IF ( rc /= ESMF_SUCCESS) THEN
 219        CALL wrf_error_fatal ( 'ESMF_StateGet(numItems) failed' )
 220      ENDIF
 221      ! allocate an array to hold the types of all items
 222      ALLOCATE( itemTypes(numItems) )
 223      ! allocate an array to hold the names of all items
 224      ALLOCATE( itemNames(numItems) )
 225      ! get the item types and names
 226      CALL ESMF_StateGet(state, itemtypeList=itemTypes, &
 227                         itemNameList=itemNames, rc=rc)
 228      IF ( rc /= ESMF_SUCCESS) THEN
 229        WRITE(str,*) 'ESMF_StateGet itemTypes failed with rc = ', rc
 230        CALL wrf_error_fatal ( str )
 231      ENDIF
 232      ! count how many items are ESMF_States
 233      numStates = 0
 234      DO i=1,numItems
 235        IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
 236          numStates = numStates + 1
 237        ENDIF
 238      ENDDO
 239      ALLOCATE( startTimes(numStates), stopTimes(numStates), &
 240                couplingIntervals(numStates) )
 241      IF ( numStates > 0) THEN
 242        ! finally, extract nested ESMF_States by name, if there are any
 243        ! (should be able to do this by index at least!)
 244        istate = 0
 245        DO i=1,numItems
 246          IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
 247            CALL ESMF_StateGet( state, itemName=TRIM(itemNames(i)), &
 248                                nestedState=tmpState, rc=rc )
 249            IF ( rc /= ESMF_SUCCESS) THEN
 250              WRITE(str,*) 'ESMF_StateGet(',TRIM(itemNames(i)),') failed'
 251              CALL wrf_error_fatal ( str )
 252            ENDIF
 253            istate = istate + 1
 254            CALL GetTimesFromState( tmpState, startTimes(istate),         &
 255                                              stopTimes(istate),          &
 256                                              couplingIntervals(istate), rc )
 257            IF ( rc /= ESMF_SUCCESS ) THEN
 258              istate = istate - 1
 259            ENDIF
 260          ENDIF
 261        ENDDO
 262        IF ( istate .EQ. 1 ) THEN
 263         ! this presupposes that 1 of the child states exist and has
 264         ! valid times in it.  Use that one.
 265           WRITE(mess,*)'WARNING: Only ',TRIM(itemNames(1)),&
 266                        ' is valid and has time info in it.  Using that.'
 267           CALL wrf_message(mess)
 268           CALL ESMF_StateGet( state, itemName=TRIM(itemNames(1)), &
 269                               nestedState=tmpState, rc=rc )
 270           CALL GetTimesFromState( tmpState, startTime, stopTime, &
 271                                   couplingInterval , rc )
 272        ELSE IF ( istate .GT. 1 ) THEN
 273           CALL ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
 274                                startTime,  stopTime,  couplingInterval )
 275        ELSE
 276           CALL wrf_error_fatal('no valid states with times found. giving up.')
 277        ENDIF
 278      ELSE
 279        ! there are no nested ESMF_States so use parent state only
 280        CALL GetTimesFromState( state, startTime, stopTime, &
 281                                couplingInterval , rc )
 282      ENDIF
 283
 284      ! deallocate locals
 285      DEALLOCATE( itemTypes )
 286      DEALLOCATE( itemNames )
 287      DEALLOCATE( startTimes, stopTimes, couplingIntervals )
 288
 289    END SUBROUTINE GetTimesFromStates
 290
 291
 292    ! Reconcile all times and intervals in startTimes, stopTimes, and
 293    ! couplingIntervals and return the results in startTime, stopTime, and
 294    ! couplingInterval.  Abort if reconciliation is not possible.
 295    SUBROUTINE ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
 296                               startTime,  stopTime,  couplingInterval )
 297      TYPE(ESMF_Time),         INTENT(INOUT) :: startTimes(:)
 298      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTimes(:)
 299      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingIntervals(:)
 300      TYPE(ESMF_Time),         INTENT(INOUT) :: startTime
 301      TYPE(ESMF_Time),         INTENT(INOUT) :: stopTime
 302      TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
 303      ! locals
 304      INTEGER :: numTimes, numTimesTmp, i
 305
 306      ! how many sets of time info?
 307      numTimes = SIZE(startTimes)
 308      IF ( numTimes < 2 ) THEN
 309        CALL wrf_error_fatal ( 'SIZE(startTimes) too small' )
 310      ENDIF
 311      numTimesTmp = SIZE(stopTimes)
 312      IF ( numTimes /= numTimesTmp ) THEN
 313        CALL wrf_error_fatal ( 'incorrect SIZE(stopTimes)' )
 314      ENDIF
 315      numTimesTmp = SIZE(couplingIntervals)
 316      IF ( numTimes /= numTimesTmp ) THEN
 317        CALL wrf_error_fatal ( 'incorrect SIZE(couplingIntervals)' )
 318      ENDIF
 319
 320      ! reconcile
 321 !TODO:  For now this is very simple.  Fancy it up later.
 322      DO i = 1, numTimes
 323        IF ( i == 1 ) THEN
 324          startTime = startTimes(i)
 325          stopTime = stopTimes(i)
 326          couplingInterval = couplingIntervals(i)
 327        ELSE
 328 !jm         IF ( startTimes(i) /= startTime ) THEN
 329 !jm           CALL wrf_message ( 'ReconcileTimes:  inconsistent startTimes. Using first.' )
 330 !jm           startTimes(i) = startTime
 331 !jm         ENDIF
 332 !jm         IF ( stopTimes(i) /= stopTime ) THEN
 333 !jm           CALL wrf_message ( 'ReconcileTimes:  inconsistent stopTimes. Using first.' )
 334 !jm           stopTimes(i) = stopTime
 335 !jm         ENDIF
 336          IF ( startTimes(i) > startTime ) THEN
 337            CALL wrf_message ( 'ReconcileTimes:  inconsistent startTimes. Using later.' )
 338            startTime = startTimes(i)
 339          ENDIF
 340          IF ( stopTimes(i) < stopTime ) THEN
 341            CALL wrf_message ( 'ReconcileTimes:  inconsistent stopTimes. Using earlier.' )
 342            stopTime = stopTimes(i)
 343          ENDIF
 344          IF ( couplingIntervals(i) /= couplingInterval ) THEN
 345            CALL wrf_message ( 'ReconcileTimes:  inconsistent couplingIntervals. Using first.' )
 346            couplingIntervals(i) = couplingInterval
 347          ENDIF
 348        ENDIF
 349      ENDDO
 350      stopTimes = stopTime
 351      startTimes = startTime
 352
 353    END SUBROUTINE ReconcileTimes
 354
 355
 356
 357    !TODO:  Eliminate this once this information can be derived via other
 358    !TODO:  means.
 359    SUBROUTINE AttachDecompToState( state,                        &
 360                                    ids, ide, jds, jde, kds, kde, &
 361                                    ims, ime, jms, jme, kms, kme, &
 362                                    ips, ipe, jps, jpe, kps, kpe, &
 363                                    domdesc, bdy_mask )
 364      TYPE(ESMF_State), INTENT(INOUT) :: state
 365      INTEGER,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde
 366      INTEGER,          INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
 367      INTEGER,          INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
 368      INTEGER,          INTENT(IN   ) :: domdesc
 369      LOGICAL,          INTENT(IN   ) :: bdy_mask(4)
 370      ! locals
 371      INTEGER :: i, rc
 372      ! big enough to hold the integer values listed above
 373      INTEGER(ESMF_KIND_I4) :: intvals(19)
 374      ! big enough to hold the logical values listed above
 375 !     TYPE(ESMF_Logical) :: logvals(4)
 376      logical :: logvals(4)
 377
 378      ! first the logicals
 379      ! Usually, when writing an API for a target language, it is considered
 380      ! good practice to use native types of the target language in the
 381      ! interfaces.
 382      logvals = .FALSE.
 383      DO i = 1, SIZE(bdy_mask)
 384        IF (bdy_mask(i)) THEN
 385          logvals(i) = .TRUE.
 386        ENDIF
 387      ENDDO
 388      CALL ESMF_AttributeSet(state, 'DecompositionLogicals', logvals, itemCount=SIZE(logvals), rc=rc)
 389      IF ( rc /= ESMF_SUCCESS) THEN
 390        CALL wrf_error_fatal ( 'ESMF_AttributeSet(DecompositionLogicals) failed' )
 391      ENDIF
 392      ! now the integers
 393      intvals(1) = ids
 394      intvals(2) = ide
 395      intvals(3) = jds
 396      intvals(4) = jde
 397      intvals(5) = kds
 398      intvals(6) = kde
 399      intvals(7) = ims
 400      intvals(8) = ime
 401      intvals(9) = jms
 402      intvals(10) = jme
 403      intvals(11) = kms
 404      intvals(12) = kme
 405      intvals(13) = ips
 406      intvals(14) = ipe
 407      intvals(15) = jps
 408      intvals(16) = jpe
 409      intvals(17) = kps
 410      intvals(18) = kpe
 411      intvals(19) = domdesc
 412      CALL ESMF_AttributeSet(state, 'DecompositionIntegers', intvals, itemCount=SIZE(intvals), rc=rc)
 413      IF ( rc /= ESMF_SUCCESS) THEN
 414        CALL wrf_error_fatal ( 'ESMF_AttributeSet(DecompositionIntegers) failed' )
 415      ENDIF
 416    END SUBROUTINE AttachDecompToState
 417
 418
 419
 420    !TODO:  Eliminate this once this information can be derived via other
 421    !TODO:  means.
 422    SUBROUTINE GetDecompFromState( state,                        &
 423                                   ids, ide, jds, jde, kds, kde, &
 424                                   ims, ime, jms, jme, kms, kme, &
 425                                   ips, ipe, jps, jpe, kps, kpe, &
 426                                   domdesc, bdy_mask )
 427      TYPE(ESMF_State), INTENT(INOUT) :: state
 428      INTEGER,          INTENT(  OUT) :: ids, ide, jds, jde, kds, kde
 429      INTEGER,          INTENT(  OUT) :: ims, ime, jms, jme, kms, kme
 430      INTEGER,          INTENT(  OUT) :: ips, ipe, jps, jpe, kps, kpe
 431      INTEGER,          INTENT(  OUT) :: domdesc
 432      LOGICAL,          INTENT(  OUT) :: bdy_mask(4)
 433      ! locals
 434      INTEGER :: i, rc
 435      ! big enough to hold the integer values listed above
 436      INTEGER(ESMF_KIND_I4) :: intvals(19)
 437      ! big enough to hold the logical values listed above
 438      logical :: logvals(4)
 439      integer :: thecount ! ah ah ah
 440
 441      ! first the logicals
 442      thecount = SIZE(logvals)
 443      CALL ESMF_AttributeGet(state, 'DecompositionLogicals', logvals, itemCount=thecount, rc=rc)
 444      IF ( rc /= ESMF_SUCCESS) THEN
 445        CALL wrf_error_fatal ( 'ESMF_AttributeGet(DecompositionLogicals) failed' )
 446      ENDIF
 447      ! Usually, when writing an API for a target language, it is considered
 448      ! good practice to use native types of the target language in the
 449      ! interfaces.
 450      bdy_mask = .FALSE.
 451      DO i = 1, SIZE(logvals)
 452        IF (logvals(i) ) THEN
 453          bdy_mask(i) = .TRUE.
 454        ENDIF
 455      ENDDO
 456      ! now the integers
 457      thecount = SIZE(intvals)
 458      CALL ESMF_AttributeGet(state, 'DecompositionIntegers', intvals, itemCount=thecount, rc=rc)
 459      IF ( rc /= ESMF_SUCCESS) THEN
 460        CALL wrf_error_fatal ( 'ESMF_AttributeGet(DecompositionIntegers) failed' )
 461      ENDIF
 462      ids = intvals(1)
 463      ide = intvals(2)
 464      jds = intvals(3)
 465      jde = intvals(4)
 466      kds = intvals(5)
 467      kde = intvals(6)
 468      ims = intvals(7)
 469      ime = intvals(8)
 470      jms = intvals(9)
 471      jme = intvals(10)
 472      kms = intvals(11)
 473      kme = intvals(12)
 474      ips = intvals(13)
 475      ipe = intvals(14)
 476      jps = intvals(15)
 477      jpe = intvals(16)
 478      kps = intvals(17)
 479      kpe = intvals(18)
 480      domdesc = intvals(19)
 481    END SUBROUTINE GetDecompFromState
 482
 483
 484
 485 END MODULE module_metadatautils
 486
 487
 488
 489 MODULE module_wrf_component_top
 490 !<DESCRIPTION>
 491 ! This module defines wrf_component_init1(), wrf_component_init2(),
 492 ! wrf_component_run(), and wrf_component_finalize() routines that are called
 493 ! when WRF is run as an ESMF component.
 494 !</DESCRIPTION>
 495
 496    USE ESMF
 497    USE module_wrf_top, ONLY : wrf_init, wrf_run, wrf_finalize
 498    USE module_domain, ONLY : head_grid, get_ijk_from_grid
 499    USE module_state_description
 500    USE module_streams
 501
 502    USE module_esmf_extensions
 503    USE module_metadatautils, ONLY: AttachTimesToState, AttachDecompToState
 504
 505
 506
 507    IMPLICIT NONE
 508
 509    ! everything is private by default
 510    PRIVATE
 511
 512    ! Public entry points
 513    PUBLIC wrf_component_init1
 514    PUBLIC wrf_component_init2
 515    PUBLIC wrf_component_run
 516    PUBLIC wrf_component_finalize
 517
 518    ! private stuff
 519    CHARACTER (ESMF_MAXSTR) :: str
 520
 521 CONTAINS
 522
 523
 524    SUBROUTINE wrf_component_init1( gcomp, importState, exportState, clock, rc )
 525      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 526      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
 527      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
 528      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 529 #ifdef DM_PARALLEL
 530      TYPE(ESMF_VM) :: vm
 531      INTEGER :: mpicomtmp
 532 #endif
 533      INTEGER,                     INTENT(  OUT) :: rc
 534 !<DESCRIPTION>
 535 !     WRF component init routine, phase 1.  Passes relevant coupling
 536 !     information back as metadata on exportState.
 537 !
 538 !     The arguments are:
 539 !       gcomp           Component
 540 !       importState     Importstate
 541 !       exportState     Exportstate
 542 !       clock           External clock
 543 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 544 !                       otherwise ESMF_FAILURE.
 545 !</DESCRIPTION>
 546 !TODO:  Note that much of the decomposition-related meta-data attached to the
 547 !TODO:  exportState are WRF-specific and are only useful if other components
 548 !TODO:  want to re-use the WRF IOAPI with the same decomposition as the WRF
 549 !TODO:  model.  This is true for the simple WRF+CPL+SST test case, but will
 550 !TODO:  not be in general.  Of course other components are free to ignore this
 551 !TODO:  information.
 552
 553      ! Local variables
 554      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 555      TYPE(ESMF_State),    POINTER :: p_importState
 556      TYPE(ESMF_State),    POINTER :: p_exportState
 557      TYPE(ESMF_Clock),    POINTER :: p_clock
 558      ! Time hackery
 559      TYPE(ESMF_Time) :: startTime
 560      TYPE(ESMF_Time) :: stopTime
 561      TYPE(ESMF_TimeInterval) :: couplingInterval
 562      ! decomposition hackery
 563      INTEGER :: ids, ide, jds, jde, kds, kde
 564      INTEGER :: ims, ime, jms, jme, kms, kme
 565      INTEGER :: ips, ipe, jps, jpe, kps, kpe
 566      INTEGER :: domdesc
 567      LOGICAL :: bdy_mask(4)
 568      CHARACTER(LEN=256) :: couplingIntervalString
 569
 570      rc = ESMF_SUCCESS
 571
 572      p_gcomp => gcomp
 573      p_importState => importState
 574      p_exportState => exportState
 575      p_clock => clock
 576      ! NOTE:  It will be possible to remove this call once ESMF supports
 577      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 578      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 579      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 580                            exportState=p_exportState, clock=p_clock )
 581
 582 #ifdef DM_PARALLEL
 583      CALL ESMF_VMGetCurrent(vm, rc=rc)
 584      IF ( rc /= ESMF_SUCCESS ) THEN
 585        CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_VMGetCurrent failed' )
 586      ENDIF
 587      CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc)
 588      IF ( rc /= ESMF_SUCCESS ) THEN
 589        CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_VMGet failed' )
 590      ENDIF
 591      CALL wrf_set_dm_communicator( mpicomtmp )
 592 #endif
 593
 594      ! Call WRF "init" routine, which, for a DM_PARALLEL run, will recognize
 595      ! that ESMF has already called MPI_INIT and respond appropriately.
 596      CALL wrf_init( no_init1=.TRUE. )
 597
 598      ! For now, use settings from WRF component intialization to set up
 599      ! top-level clock.  Per suggestion from ESMF Core team, these are passed
 600      ! back as attributes on exportState.
 601      CALL wrf_clockprint( 100, head_grid%domain_clock, &
 602             'DEBUG wrf_component_init1():  head_grid%domain_clock,' )
 603      CALL ESMF_ClockGet(head_grid%domain_clock, startTime=startTime, &
 604                         stopTime=stopTime, rc=rc)
 605      IF ( rc /= ESMF_SUCCESS ) THEN
 606        CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_ClockGet failed' )
 607      ENDIF
 608      CALL wrf_debug( 500, 'DEBUG wrf_component_init1():  before wrf_findCouplingInterval' )
 609      CALL wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
 610      CALL wrf_debug( 500, 'DEBUG wrf_component_init1():  after wrf_findCouplingInterval' )
 611      CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
 612                                 rc=rc )
 613      IF ( rc /= ESMF_SUCCESS ) THEN
 614        CALL wrf_error_fatal ( 'wrf_component_init1:  ESMF_TimeIntervalGet failed' )
 615      ENDIF
 616      CALL wrf_debug( 100, 'DEBUG wrf_component_init1():  couplingInterval = '//TRIM(couplingIntervalString) )
 617      CALL AttachTimesToState( exportState, startTime, stopTime, couplingInterval )
 618      CALL wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
 619                              ims, ime, jms, jme, kms, kme, &
 620                              ips, ipe, jps, jpe, kps, kpe, &
 621                              domdesc, bdy_mask )
 622      CALL AttachDecompToState( exportState,                  &
 623                                ids, ide, jds, jde, kds, kde, &
 624                                ims, ime, jms, jme, kms, kme, &
 625                                ips, ipe, jps, jpe, kps, kpe, &
 626                                domdesc, bdy_mask )
 627      CALL AttachDecompToState( importState,                  &
 628                                ids, ide, jds, jde, kds, kde, &
 629                                ims, ime, jms, jme, kms, kme, &
 630                                ips, ipe, jps, jpe, kps, kpe, &
 631                                domdesc, bdy_mask )
 632
 633    END SUBROUTINE wrf_component_init1
 634
 635
 636
 637    SUBROUTINE wrf_component_init2( gcomp, importState, exportState, clock, rc )
 638      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 639      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState
 640      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: exportState
 641      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 642      INTEGER,                     INTENT(  OUT) :: rc
 643 !<DESCRIPTION>
 644 !     WRF component init routine, phase 2.  Initializes importState and
 645 !     exportState.
 646 !
 647 !     The arguments are:
 648 !       gcomp           Component
 649 !       importState     Importstate
 650 !       exportState     Exportstate
 651 !       clock           External clock
 652 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 653 !                       otherwise ESMF_FAILURE.
 654 !</DESCRIPTION>
 655
 656      ! Local variables
 657      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 658      TYPE(ESMF_State),    POINTER :: p_importState
 659      TYPE(ESMF_State),    POINTER :: p_exportState
 660      TYPE(ESMF_Clock),    POINTER :: p_clock
 661      ! Time hackery
 662      TYPE(ESMF_Time) :: startTime
 663      TYPE(ESMF_Time) :: stopTime
 664      TYPE(ESMF_TimeInterval) :: couplingInterval
 665      ! decomposition hackery
 666      INTEGER :: ids, ide, jds, jde, kds, kde
 667      INTEGER :: ims, ime, jms, jme, kms, kme
 668      INTEGER :: ips, ipe, jps, jpe, kps, kpe
 669      INTEGER :: domdesc
 670      LOGICAL :: bdy_mask(4)
 671      INTEGER :: itemCount, i
 672      TYPE(ESMF_StateIntent_Flag) :: stateintent
 673      CHARACTER (ESMF_MAXSTR) :: statename
 674      CHARACTER (ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
 675      TYPE(ESMF_StateItem_Flag), ALLOCATABLE :: itemTypes(:)
 676
 677      CALL wrf_debug ( 100, 'wrf_component_init2():  begin' )
 678
 679      ! check exportState
 680      CALL ESMF_StateGet( exportState, itemCount=itemCount, &
 681                          stateintent=stateintent, rc=rc )
 682      IF ( rc /= ESMF_SUCCESS ) THEN
 683        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed" )
 684      ENDIF
 685      WRITE (str,*) 'wrf_component_init2: exportState itemCount = ', itemCount
 686      CALL wrf_debug ( 100 , TRIM(str) )
 687      IF ( stateintent /= ESMF_STATEINTENT_EXPORT ) THEN
 688        CALL wrf_error_fatal("wrf_component_init2:  exportState is not an export state" )
 689      ENDIF
 690
 691      ! check importState
 692      CALL ESMF_StateGet( importState, itemCount=itemCount, &
 693                          stateintent=stateintent, rc=rc )
 694      IF ( rc /= ESMF_SUCCESS ) THEN
 695        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed" )
 696      ENDIF
 697      WRITE (str,*) 'wrf_component_init2: importState itemCount = ', itemCount
 698      CALL wrf_debug ( 100 , TRIM(str) )
 699      IF ( stateintent /= ESMF_STATEINTENT_IMPORT ) THEN
 700        CALL wrf_error_fatal("wrf_component_init2:  importState is not an import state" )
 701      ENDIF
 702
 703      p_gcomp => gcomp
 704      p_importState => importState
 705      p_exportState => exportState
 706      p_clock => clock
 707      ! NOTE:  It will be possible to remove this call once ESMF supports
 708      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 709      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 710      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 711                            exportState=p_exportState, clock=p_clock )
 712
 713      ! populate ESMF import and export states
 714      CALL wrf_state_populate( rc )
 715      IF ( rc /= 0 ) THEN
 716        CALL wrf_error_fatal ( 'wrf_component_init2:  wrf_state_populate failed' )
 717      ENDIF
 718
 719      ! examine importState
 720      WRITE (str,*) 'wrf_component_init2: EXAMINING importState...'
 721      CALL wrf_debug ( 100 , TRIM(str) )
 722      CALL ESMF_StateGet( importState, itemCount=itemCount, &
 723                          stateintent=stateintent, name=statename, rc=rc )
 724      IF ( rc /= ESMF_SUCCESS ) THEN
 725        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed B" )
 726      ENDIF
 727      IF ( stateintent /= ESMF_STATEINTENT_IMPORT ) THEN
 728        CALL wrf_error_fatal("wrf_component_init2:  importState is not an import state" )
 729      ENDIF
 730      WRITE (str,*) 'wrf_component_init2: importState <',TRIM(statename), &
 731                    '> itemCount = ', itemCount
 732      CALL wrf_debug ( 100 , TRIM(str) )
 733      ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
 734      CALL ESMF_StateGet( importState, itemNameList=itemNames, &
 735                          itemtypeList=itemTypes, rc=rc )
 736      IF ( rc /= ESMF_SUCCESS ) THEN
 737        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(importState) failed C" )
 738      ENDIF
 739      DO i=1, itemCount
 740        IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
 741          WRITE(str,*) 'wrf_component_init2: importState contains field <',TRIM(itemNames(i)),'>'
 742          CALL wrf_debug ( 100 , TRIM(str) )
 743        ENDIF
 744      ENDDO
 745      DEALLOCATE ( itemNames, itemTypes )
 746      WRITE (str,*) 'wrf_component_init2: DONE EXAMINING importState...'
 747      CALL wrf_debug ( 100 , TRIM(str) )
 748
 749      ! examine exportState
 750      WRITE (str,*) 'wrf_component_init2: EXAMINING exportState...'
 751      CALL wrf_debug ( 100 , TRIM(str) )
 752      CALL ESMF_StateGet( exportState, itemCount=itemCount, &
 753                          stateintent=stateintent, name=statename, rc=rc )
 754      IF ( rc /= ESMF_SUCCESS ) THEN
 755        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed B" )
 756      ENDIF
 757      IF ( stateintent /= ESMF_STATEINTENT_EXPORT ) THEN
 758        CALL wrf_error_fatal("wrf_component_init2:  exportState is not an export state" )
 759      ENDIF
 760      WRITE (str,*) 'wrf_component_init2: exportState <',TRIM(statename), &
 761                    '> itemCount = ', itemCount
 762      CALL wrf_debug ( 100 , TRIM(str) )
 763      ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
 764      CALL ESMF_StateGet( exportState, itemNameList=itemNames, &
 765                          itemtypeList=itemTypes, rc=rc )
 766      IF ( rc /= ESMF_SUCCESS ) THEN
 767        CALL wrf_error_fatal("wrf_component_init2:  ESMF_StateGet(exportState) failed C" )
 768      ENDIF
 769      DO i=1, itemCount
 770        IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
 771          WRITE(str,*) 'wrf_component_init2: exportState contains field <',TRIM(itemNames(i)),'>'
 772          CALL wrf_debug ( 100 , TRIM(str) )
 773        ENDIF
 774      ENDDO
 775      DEALLOCATE ( itemNames, itemTypes )
 776      WRITE (str,*) 'wrf_component_init2: DONE EXAMINING exportState...'
 777      CALL wrf_debug ( 100 , TRIM(str) )
 778
 779      CALL wrf_debug ( 100, 'DEBUG wrf_component_init2():  end' )
 780
 781    END SUBROUTINE wrf_component_init2
 782
 783
 784
 785    SUBROUTINE wrf_component_run( gcomp, importState, exportState, clock, rc )
 786      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 787      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
 788      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 789      INTEGER,                     INTENT(  OUT) :: rc
 790 !<DESCRIPTION>
 791 !     WRF component run routine.
 792 !
 793 !     The arguments are:
 794 !       gcomp           Component
 795 !       importState     Importstate
 796 !       exportState     Exportstate
 797 !       clock           External clock
 798 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 799 !                       otherwise ESMF_FAILURE.
 800 !</DESCRIPTION>
 801
 802      ! Local variables
 803      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 804      TYPE(ESMF_State),    POINTER :: p_importState
 805      TYPE(ESMF_State),    POINTER :: p_exportState
 806      TYPE(ESMF_Clock),    POINTER :: p_clock
 807      ! timing
 808      TYPE(ESMF_Time) :: currentTime, nextTime
 809      TYPE(ESMF_TimeInterval) :: runLength     ! how long to run in this call
 810      CHARACTER(LEN=256) :: timeStr
 811
 812      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  begin' )
 813
 814      p_gcomp => gcomp
 815      p_importState => importState
 816      p_exportState => exportState
 817      p_clock => clock
 818      ! NOTE:  It will be possible to remove this call once ESMF supports
 819      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 820      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 821      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 822                            exportState=p_exportState, clock=p_clock )
 823
 824      ! connect ESMF clock with WRF domain clock
 825      CALL ESMF_ClockGet( clock, currTime=currentTime, timeStep=runLength, rc=rc )
 826      IF ( rc /= ESMF_SUCCESS ) THEN
 827        CALL wrf_error_fatal ( 'wrf_component_run:  ESMF_ClockGet failed' )
 828      ENDIF
 829      CALL wrf_clockprint(100, clock, &
 830             'DEBUG wrf_component_run():  clock,')
 831      nextTime = currentTime + runLength
 832      head_grid%start_subtime = currentTime
 833      head_grid%stop_subtime = nextTime
 834      CALL wrf_timetoa ( head_grid%start_subtime, timeStr )
 835      WRITE (str,*) 'wrf_component_run:  head_grid%start_subtime ',TRIM(timeStr)
 836      CALL wrf_debug ( 100 , TRIM(str) )
 837      CALL wrf_timetoa ( head_grid%stop_subtime, timeStr )
 838      WRITE (str,*) 'wrf_component_run:  head_grid%stop_subtime ',TRIM(timeStr)
 839      CALL wrf_debug ( 100 , TRIM(str) )
 840
 841      ! Call WRF "run" routine
 842      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  calling wrf_run()' )
 843      CALL wrf_run( )
 844      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  back from wrf_run()' )
 845
 846      CALL wrf_debug ( 100 , 'DEBUG wrf_component_run():  end' )
 847
 848    END SUBROUTINE wrf_component_run
 849
 850
 851
 852    SUBROUTINE wrf_component_finalize( gcomp, importState, exportState, clock, rc )
 853      TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
 854      TYPE(ESMF_State),    TARGET, INTENT(INOUT) :: importState, exportState
 855      TYPE(ESMF_Clock),    TARGET, INTENT(INOUT) :: clock
 856      INTEGER,                     INTENT(  OUT) :: rc
 857 !<DESCRIPTION>
 858 !     WRF component finalize routine.
 859 !
 860 !     The arguments are:
 861 !       gcomp           Component
 862 !       importState     Importstate
 863 !       exportState     Exportstate
 864 !       clock           External clock
 865 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
 866 !                       otherwise ESMF_FAILURE.
 867 !</DESCRIPTION>
 868
 869      ! Local variables
 870      TYPE(ESMF_GridComp), POINTER :: p_gcomp
 871      TYPE(ESMF_State),    POINTER :: p_importState
 872      TYPE(ESMF_State),    POINTER :: p_exportState
 873      TYPE(ESMF_Clock),    POINTER :: p_clock
 874      INTEGER :: rc
 875      p_gcomp => gcomp
 876      p_importState => importState
 877      p_exportState => exportState
 878      p_clock => clock
 879      ! NOTE:  It will be possible to remove this call once ESMF supports
 880      !        interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
 881      !        ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
 882      CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
 883                            exportState=p_exportState, clock=p_clock )
 884
 885      ! Call WRF "finalize" routine, suppressing call to MPI_FINALIZE so
 886      ! ESMF can do it (if needed) during ESMF_Finalize().
 887      CALL wrf_finalize( no_shutdown=.TRUE. )
 888
 889      rc = ESMF_SUCCESS
 890
 891    END SUBROUTINE wrf_component_finalize
 892
 893
 894
 895    SUBROUTINE wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
 896      TYPE(ESMF_Time),         INTENT(IN   ) :: startTime
 897      TYPE(ESMF_Time),         INTENT(IN   ) :: stopTime
 898      TYPE(ESMF_TimeInterval), INTENT(  OUT) :: couplingInterval
 899 !<DESCRIPTION>
 900 !     WRF convenience routine for deducing coupling interval.  The startTime
 901 !     and stopTime arguments are only used for determining a default value
 902 !     when coupling is not actually being done.
 903 !
 904 !     The arguments are:
 905 !       startTime          start time
 906 !       stopTime           stop time
 907 !       couplingInterval   coupling interval
 908 !</DESCRIPTION>
 909      ! locals
 910      LOGICAL :: foundcoupling
 911      INTEGER :: rc
 912      INTEGER :: io_form
 913      ! external function prototype
 914      INTEGER, EXTERNAL :: use_package
 915
 916      ! deduce coupling time-step
 917      foundcoupling = .FALSE.
 918 !TODO:  This bit just finds the FIRST case and extracts coupling interval...
 919 !TODO:  Add error-checking for over-specification.
 920 !TODO:  Add support for multiple coupling intervals later...
 921 !TODO:  Add support for coupling that does not begin immediately later...
 922 !TODO:  Get rid of duplication once I/O refactoring is finished (and
 923 !TODO:  auxio streams can be addressed via index).
 924
 925 #include "med_find_esmf_coupling.inc"
 926
 927      ! look for erroneous use of io_form...
 928      CALL nl_get_io_form_restart( 1, io_form )
 929      IF ( use_package( io_form ) == IO_ESMF ) THEN
 930        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF restart I/O' )
 931      ENDIF
 932      CALL nl_get_io_form_input( 1, io_form )
 933      IF ( use_package( io_form ) == IO_ESMF ) THEN
 934        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF input' )
 935      ENDIF
 936      CALL nl_get_io_form_history( 1, io_form )
 937      IF ( use_package( io_form ) == IO_ESMF ) THEN
 938        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF history output' )
 939      ENDIF
 940      CALL nl_get_io_form_boundary( 1, io_form )
 941      IF ( use_package( io_form ) == IO_ESMF ) THEN
 942        CALL wrf_error_fatal ( 'wrf_findCouplingInterval:  ERROR:  ESMF cannot be used for WRF boundary I/O' )
 943      ENDIF
 944
 945      ! If nobody uses IO_ESMF, then default is to run WRF all the way to
 946      ! the end.
 947      IF ( .NOT. foundcoupling ) THEN
 948        couplingInterval = stopTime - startTime
 949        call wrf_debug ( 1, 'WARNING:  ESMF coupling not used in this WRF run' )
 950      ENDIF
 951
 952    END SUBROUTINE wrf_findCouplingInterval
 953
 954
 955
 956    SUBROUTINE wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
 957                                  ims, ime, jms, jme, kms, kme, &
 958                                  ips, ipe, jps, jpe, kps, kpe, &
 959                                  domdesc, bdy_mask )
 960      INTEGER, INTENT(OUT) :: ids, ide, jds, jde, kds, kde
 961      INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme
 962      INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe
 963      INTEGER, INTENT(OUT) :: domdesc
 964      LOGICAL, INTENT(OUT) :: bdy_mask(4)
 965 !<DESCRIPTION>
 966 !     WRF convenience routine for deducing decomposition information.
 967 !TODO:  Note that domdesc is meaningful only for SPMD alternating event loops.
 968 !TODO:  For concurrent operation (SPMD or MPMD), we will need to create a new
 969 !TODO:  "domdesc" suitable for the task layout of the SST component.  For
 970 !TODO:  MPMD alternating event loops, we will need to serialize domdesc and
 971 !TODO:  store it as metadata within the export state.  Similar arguments apply
 972 !TODO:  to [ij][mp][se] and bdy_mask.
 973 !
 974 !     The arguments are:
 975 !       ids, ide, jds, jde, kds, kde    Domain extent.
 976 !       ims, ime, jms, jme, kms, kme    Memory extent.
 977 !       ips, ipe, jps, jpe, kps, kpe    Patch extent.
 978 !       domdesc                         Domain descriptor for external
 979 !                                       distributed-memory communication
 980 !                                       package (opaque to WRF).
 981 !       bdy_mask                        Boundary mask flags indicating which
 982 !                                       domain boundaries are on this task.
 983 !</DESCRIPTION>
 984      ! extract decomposition information from head_grid
 985      CALL get_ijk_from_grid( head_grid ,                   &
 986                              ids, ide, jds, jde, kds, kde, &
 987                              ims, ime, jms, jme, kms, kme, &
 988                              ips, ipe, jps, jpe, kps, kpe  )
 989 #if 0
 990 ! JM
 991 ! with version 3 of ESMF's staggering concepts, WRF's non-staggered grid is equivalent to
 992 ! esmf's 'exclusive' region -- that is the set of points that are owned by the 'DE' (eyeroll)
 993 ! WRF, on the other hand, is returning the 'staggered' dimensions here.  So convert to the
 994 ! unstaggered dims before returning.
 995 ! Don't bother with vertical dimension for the time being, since we're only doing 2D coupling.
 996 !
 997      ide = ide-1 ; ipe = MIN(ide,ipe)
 998      jde = jde-1 ; jpe = MIN(jde,jpe)
 999 #else
1000 ! JM
1001 ! with version 4 I have no damned clue at this writing... just random shots for now
1002 ! see if this works.
1003      ipe = MIN(ide-1,ipe)
1004      jpe = MIN(jde-1,jpe)
1005 #endif
1006
1007      domdesc = head_grid%domdesc
1008      bdy_mask = head_grid%bdy_mask
1009    END SUBROUTINE wrf_getDecompInfo
1010
1011
1012    SUBROUTINE wrf_state_populate( ierr )
1013      ! Driver layer
1014      USE module_domain, ONLY : domain
1015      USE module_io_domain
1016      ! Model layer
1017      USE module_configure, ONLY : grid_config_rec_type, model_to_grid_config_rec
1018      USE module_bc_time_utilities
1019
1020      IMPLICIT NONE
1021
1022 !<DESCRIPTION>
1023 !     Populate WRF import and export states from Registry-generated code.
1024 !     For now, only head_grid can be coupled.
1025 !
1026 !</DESCRIPTION>
1027 !TODO:  Extend later to include child
1028 !TODO:  domains, possibly via nested ESMF_State's.
1029
1030      ! Arguments
1031      INTEGER, INTENT(OUT)       :: ierr
1032      ! Local
1033      TYPE(domain), POINTER      :: grid
1034      TYPE(grid_config_rec_type) :: config_flags
1035      INTEGER                    :: stream, idum1, idum2, io_form
1036      CHARACTER*80               :: fname, n2
1037      ! external function prototype
1038      INTEGER, EXTERNAL          :: use_package
1039
1040      ! for now support coupling to head_grid only
1041      grid => head_grid
1042 ! TODO:  Use actual grid via current_grid%id via something like this...
1043 !  IF ( current_grid_set ) THEN
1044 !    grid => current_grid
1045 !  ELSE
1046 !    ERROR
1047 !  ENDIF
1048
1049      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
1050      CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
1051
1052      stream = 0
1053      ierr = 0
1054
1055 #include "med_open_esmf_calls.inc"
1056
1057    END SUBROUTINE wrf_state_populate
1058
1059 END MODULE module_wrf_component_top
1060
1061
1062
1063 MODULE module_wrf_setservices
1064 !<DESCRIPTION>
1065 ! This module defines WRF "Set Services" method wrf_register()
1066 ! used for ESMF coupling.
1067 !</DESCRIPTION>
1068
1069    USE module_wrf_component_top, ONLY: wrf_component_init1, &
1070                                        wrf_component_init2, &
1071                                        wrf_component_run,   &
1072                                        wrf_component_finalize
1073    USE ESMF
1074
1075    IMPLICIT NONE
1076
1077    ! everything is private by default
1078    PRIVATE
1079
1080    ! Public entry point for ESMF_GridCompSetServices()
1081    PUBLIC WRF_register
1082
1083    ! private stuff
1084    CHARACTER (ESMF_MAXSTR) :: str
1085
1086 CONTAINS
1087
1088
1089    SUBROUTINE wrf_register(gcomp, rc)
1090      TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
1091      INTEGER, INTENT(OUT) :: rc
1092 !
1093 !<DESCRIPTION>
1094 !     WRF_register - Externally visible registration routine
1095 !
1096 !     User-supplied SetServices routine.
1097 !     The Register routine sets the subroutines to be called
1098 !     as the init, run, and finalize routines.  Note that these are
1099 !     private to the module.
1100 !
1101 !     The arguments are:
1102 !       gcomp           Component
1103 !       rc              Return code; equals ESMF_SUCCESS if there are no errors,
1104 !                       otherwise ESMF_FAILURE.
1105 !</DESCRIPTION>
1106
1107      rc = ESMF_SUCCESS
1108      ! Register the callback routines.
1109      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
1110                                      wrf_component_init1, phase=1, rc=rc)
1111      IF ( rc /= ESMF_SUCCESS) THEN
1112         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_init1) failed' )
1113      ENDIF
1114      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
1115                                      wrf_component_init2, phase=2, rc=rc)
1116      IF ( rc /= ESMF_SUCCESS) THEN
1117         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_init2) failed' )
1118      ENDIF
1119      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
1120                                      wrf_component_run,  rc=rc)
1121      IF ( rc /= ESMF_SUCCESS) THEN
1122         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_run) failed' )
1123      ENDIF
1124      call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_FINALIZE, &
1125                                      wrf_component_finalize,  rc=rc)
1126      IF ( rc /= ESMF_SUCCESS) THEN
1127         CALL wrf_error_fatal ( 'wrf_register:  ESMF_GridCompSetEntryPoint(wrf_component_finalize) failed' )
1128      ENDIF
1129      PRINT *,'WRF:  Registered Initialize, Run, and Finalize routines'
1130
1131    END SUBROUTINE wrf_register
1132
1133 END MODULE module_wrf_setservices
1134