wrf_ESMFMod.F

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